omar elhosseini

الاخ صلاح الصغير جرب المرفق مع الملف ذو الورقة المحمية لعل وعسي يعمل جيدا معك فقد قمت بالتجربة علي كلا من الاوفيس : 2010 الاوفيس : 2003 انت وحظك ربما يعمل معك علي الاوفيس : 2016 واخبرني بالنتيجة Master_4.rar

الاخ ياسر خليل أبو البراء بارك الله فيك اثريت الموضووع بالأضافة الملف بعد التعديل All Files.rar

الاخ ابو عبدالرحمن بيرم لم تجيبني علي طلبي بأن ترسل الملف الذي به الكود السابق والذي يعمل بشكل جيد فأنا اري ان به شئ غير منضبط

الاخ ابو عبدالرحمن بيرم هذا الكود لا يعمل بشكل صحيح من المفروض بعد اول ترحيل ان مجموع العمود I في ورقة ال Data 57985.32 يطابق مجموع العمود Y في ورقة Salary 44869.56 وهذا غير صحيح بالأضافة الي يجب بعد اول ترحيل عدد الاسماء في ورقة Salary يساوي او يقل عن عدد الاسماء في ورقة Data

الاخ حاتم عيسى انت هنا تعرض كودد الملف Omar_2.rar مع ملف اوراقة المعنية محمية كان من الواجب عرض كود الملف Omar_3.rar لا يجوز هذا الخلط وها هو كود الملف Omar_3.rar Option Base 1 Sub Transfer_Data() ' Dim Sh_Master As Worksheet Dim Rng As Range Dim Arr() Application.ScreenUpdating = False '====================================================================================== UnProtect_Me Set Sh_Master = Sheets("الرئيسية") For Each Sh In Sheets If Sh.Name <> Sh_Master.Name Then Sh.Range("A7:H" & Rows.Count).ClearContents End If Next End_Row = Sh_Master.Cells(Rows.Count, "C").End(xlUp).Row Set Rng = Sh_Master.Range("A6:N" & End_Row) Arr = Rng '====================================================================================== For Row = 2 To UBound(Arr) For Col = 7 To 12 If Arr(Row, Col) = 1 Then ShName = Arr(1, Col) End_Row = Sheets(ShName).Cells(Rows.Count, "C").End(xlUp).Row + 1 Set Rng = Range(Sh_Master.Cells(Row + 5, "A"), Sh_Master.Cells(Row + 5, "F")) Rng.Copy Sheets(ShName).Range("A" & End_Row) Sheets(ShName).Range("G" & End_Row) = Arr(1, Col) '============================== Sheets(ShName).Range("H" & End_Row) = Sh_Master.Cells(Row + 5, "N") - 1 ' OR ' Sheets(ShName).Range("H" & End_Row) = "عنده مواد ثانية" '============================== End If Next Next '====================================================================================== Protect_Me Application.ScreenUpdating = True ' End Sub Sub Protect_Me() ' Dim Sh As Worksheet ' Pass = "123" For Each Sh In Sheets If Sh.Name <> ActiveSheet.Name Then Sh.Protect Password:=Pass End If Next ' End Sub Sub UnProtect_Me() ' Dim Sh As Worksheet ' Pass = "123" For Each Sh In Sheets Sh.Unprotect Password:=Pass Next ' End Sub

الاخ حاتم عيسى لا يمكن حدوث ما تقول نهائيا ( لكن عند إضافة أي تلاميذ جدد وإعادة الترحيل مرة أخرى يعطي رسالة مفادها بأن الخلايا محمية ولا يمكن الترحيل .) فالكود في الملف Omar_3.rar يفك حماية الاورااق المعنية قبل الترحيل اتوماتيكيا وبعد الترحيل يضع الحماية مره اخري اعد التجربة علي الملف Omar_3.rar واخبرني النتيجة لا يمكن نهائيا حدوث هذه الرسالة لا يمكن نهائيا حدوث هذه الرسالة لا يمكن نهائيا حدوث هذه الرسالة ارجو من الاخ ياسر تجربة الملف Omar_3.rar واخباري بالنتيجة ربما اخي حاتم عيسى تكون علي حق واكون انا في غفلة من امري

هل يعمل يعمل هذا الكود اذا كان يعمل اود ان اراي الملف الذي يعمل عليه

الاخ صلاح الصغير لتخطي مشكلة حماية الملف الهدف لابد من معرفة الاتي 1- نظام الويندوز الذي تعمل عليه 2- اي نسخه للأكسيل تعمل عليها

لا ازعاج اخي ولو في اي شئ اخر تحت امرك كلنا نساعد بما نستطيع ابتغاء وجه الله الكريم

الاخ حاتم عيسى شكرا لك اخي علي كلماتك العطره كلمة مرور 123 شاهد المرفق Omar_3.rar

الاخ ابو عبدالرحمن بيرم اسف اخي علي التأخير فلم اري رسالتك الا اليوم شاهد المرفق مساهمة مني من باب تنوع الحلول كما طلبت Omar_1.rar

الاخ حاتم عيسى شاهد المرفق Omar_2.rar

الاخ حاتم عيسى شاهد المرفق Omar_1.rar

بعد اذن الاخ عبدالسلام الاخ زياد777 شاهد المرفق تحول التريخ الى رقم.rar

الاخ صلاح الصغير قائمة الفلدرات كانت لللتوضيح فقط من قبل الاخ aladdien ولكن عند اضافة اي ملف يظهر ففيي القائمة المنسلة

بعد اذن الاخ سليم حاصبيا الاخ محمد كبيش طريقة اخري بها 1- جميع الأمديه ديناميكية 2- اربع حقول للفلترة يمكن الفلترة علي أي عدد من الحقول 0 أو 1 أو 2 أو 3 أو 4 3- أوتوماتيكيا يتم تحديد 1- ناحية االطباعة 2- الصفوف المكررة إلي الأعلي 3- عدد السجلات المفلترة شاههد المرفق قاعدة بيانات ديناميكية.rar

الاخ aladdien شاهد المرفق All Files.rar

الاخ aladdien شاهد المرفق All Files.rar

ماهو طلبك اوضح طلبك

ما هو طلبك بالضبط والاهم ضع تصورك لشكل النتيجه في شيت منفصل

الملف بدون حماية Pay-mahmoudryad-20160613-110914.rar

الاخ ياسر خليل أبو البراء شكرا لك اخي من بعض ماعندكم اخي

الاخ محمد شاهد المرفق Omar_1.rar

الاخ ياسر خليل أبو البراء اخي العزيز ياسر تحياتي لك لم انتبه للدله عزرا اخي العزيز

الاخ صلاح الصغير نسخة اسرع بأستخدام المصفوفة شاهد المرفق Master_3.rar