البحث في الموقع

لدي ملف اكسل اود ان ارحل البيانات الخاصة بكل ورقة و جمعها في واحدة بكود المرجو مساعدتي و جازاكم الله خيرا ListEleve_20240320.xlsx

عندي 11 شيت ومحتاجه اعملهم زي يوميه مجمعه بكل البيانات اللي ف الشيتات دي بكل تفاصيلهم يعني كل الاعمده تنزل زي ماهي تحت بعضها في الشيت الرئيسي عشان اقدر اخد منها بيانات تحليليه بعد كده ياريت لو ف كود او اي ملف يقدر يساعدني ف ده لان الموجود ترحيل من شيت لشيت لكن ترحيل شيتات متعدده لشيت واحد غير موجوده ف البحث

السلام عليكم ورحمة الله وبركاته أخواتي وأساتذتي الكرماء عندي ملف إكسل يحتوي على بيان بالأنشطة بعدد أشهر السنة + بيان بحصر الأنشطة بالأرقام ... وعملت شيت إسمه (2022) فيه قائمة منسدلة في أعلى الجدول بأسماء شهور السنة ، وعايز لما اختار شهر من القائمة تظهر بياناته كلها في الجدول أسفله بحيث يكون يبقى شيت إضافي يتم ترحيل البيانات الخاص بالشهور كلها حسب ما أختار من القايمة المنسدلة أو أي فكرة أخرى أرحل فيها بيانات الشهور كلها في شيت واحد الل اسمه (2022) . بس ياريت تكون بالمعادلات وليس باستخدام الأكواد لأن أنا هارفع الشيت على جوجل درايف والموظفين هايشتغلوا منه ،، والجوجل درايف لا يعترف بأكواد الفيجوال فيسك . وياريت بالمرة أكبر الخط شوية في القائمة المنسدلة . جدول حجز القاعات 2022.xlsm

السلام عليكم في الملف المرفق المطلوب ترحيل البيانات من الشيتات الثلاثة الاولى الى الشيت الرابع ويتم ترتيب البيانات حسب اسم الموظف بحيث لو حصل اي تغيير في الشيتات الثلاث الاولى يحصل التغيير في الشيت الرابع ترحيل بيانات.xlsx

بسم الله الرحمن الرحيم والصلاة والسلام على اشرف المرسلين سيدنا محمد صلى الله عليه وسلم لقد قدمت سابقا نموذج فاتوره على الاكسيل بدون فورم وبناء على طلب بعض الاخوه فى شرح كيفيه عمل النموذج وتلبية لرغباتهم نتناول طريقه عمل النموذج ونظرا لضيق الوقت ان شاء الله يتم تناول درس يوميا على الاقل حتى الانتهاء بإذن الله .......................................................................... الاخوه الافاضل الحمد لله فقد انتهينا من شرح الدرس الاول وهو عباره عن ثلاثة دروس تمهيديه وهى اولا--تصميم الفاتوره ثانيا--انشاء شيت به الاكواد المساعده ثالثا--انشاء شيت لتجميع بيانات الفواتير المسجله --------------------------------------------------- الان نبدأ فى شرح الدرس الثانى وقد انتهينا سابقان من تناول الدرس الثانى ( أ ) الكود الاول--كود يقوم بعمل تسلسل لرقم الفاتوره الدرس الثانى ( ب ) الكود الثانى--كود يقوم بعمل تسلسل لبيانات الفاتوره الدرس الثانى ( ج ) كود الثالث--يقوم باحضار بيانات العميل عند كتابة الكود الخاص بالعميل الدرس الثانى ( ح ) الكود الرابع---كود يقوم باحضار بيانات الصنف عند كتابة الكود الخاص بالصنف تابع الدرس الثانى ( ح )كود يقوم باستخراج القيمه الخاصه بكل صنف ثم استخراج اجمالى قيمة الفاتوره الان نتناول شرح الدرس الثانى ( خ ) الكود الخامس---كود يقوم بترحيل بيانات الفاتوره الى شيت invoice date اولا نود ان ننبه الى ان الكود سوف يتم وضعه فى موديول جديد وسوف يتم تسميتها ب hima_trs_ طبعا اكود الترحيل كتيره جدا وان شاء الله يتم التطرق الى اكثر من كود حتى يتسنى للجميع الالمام باغلب الاكوادالتى تستخدم فى الترحيل ولكن دعونا نبدأ بالكود البسيط جدا ولكن يعيبه ان طويل جدا الكود طبعا هيبقى طويل حبه وذلك لاننا لو نظرنا الى الفاتوره سنجد ان عدد صفوفها عبارهعن 22 صف لذلك الكود يبفى عباره عن 22 شرط كل شرط هيكون مرتبط بصف من صفوف الفاتوره وطبعا شكل الكود النهائى هيكون بالشكل الاتى Sub hima_trs() Application.ScreenUpdating = False Dim LR As Long Dim WS As Worksheet Dim WS1 As Worksheet Set WS = Worksheets("INVOICE") Set WS1 = Worksheets("INVOICE DATA") LR = WS1.Range("e10000").End(xlUp).Row + 1 LR1 = WS1.Range("c10000").End(xlUp).Row + 1 For r = 3 To LR1 If WS1.Cells(r, 3) = WS.Range("f2") Then MsgBox "This invoice already exist, No shift will done": Exit Sub Next If WS.Range("d4").Value = "" Then MsgBox "enter invoice date": Exit Sub If WS.Cells(16, 3).Value = "" Then MsgBox "حد ادنى صف واحد لكى يسمح للفاتورة بالترحيل ": Exit Sub If WS.Cells(16, 3).Value <> "" Then WS1.Cells(LR, 2) = WS.Range("d4").Value WS1.Cells(LR, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR, 3) = WS.Range("f2").Value WS1.Cells(LR, 4) = WS.Range("f6").Value WS1.Cells(LR, 5) = WS.Range("d8") WS1.Cells(LR, 6) = WS.Range("h8") WS1.Cells(LR, 7) = WS.Range("d10") WS1.Cells(LR, 8) = WS.Range("d12") WS1.Cells(LR, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR, 9) = WS.Range("c16").Offset(0, 0).Value WS1.Cells(LR, 10) = WS.Range("c16").Offset(0, 1).Value WS1.Cells(LR, 11) = WS.Range("c16").Offset(0, 2).Value WS1.Cells(LR, 12) = WS.Range("c16").Offset(0, 3).Value WS1.Cells(LR, 13) = WS.Range("c16").Offset(0, 4).Value WS1.Cells(LR, 14) = WS.Range("c16").Offset(0, 5).Value WS1.Cells(LR, 15) = WS.Range("c16").Offset(0, 6).Value End If If WS.Cells(17, 3).Value <> "" Then WS1.Cells(LR + 1, 2) = WS.Range("d4").Value WS1.Cells(LR + 1, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 1, 3) = WS.Range("f2").Value WS1.Cells(LR + 1, 4) = WS.Range("f6").Value WS1.Cells(LR + 1, 5) = WS.Range("d8") WS1.Cells(LR + 1, 6) = WS.Range("h8") WS1.Cells(LR + 1, 7) = WS.Range("d10") WS1.Cells(LR + 1, 8) = WS.Range("d12") WS1.Cells(LR + 1, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 1, 9) = WS.Range("c16").Offset(1, 0).Value WS1.Cells(LR + 1, 10) = WS.Range("c16").Offset(1, 1).Value WS1.Cells(LR + 1, 11) = WS.Range("c16").Offset(1, 2).Value WS1.Cells(LR + 1, 12) = WS.Range("c16").Offset(1, 3).Value WS1.Cells(LR + 1, 13) = WS.Range("c16").Offset(1, 4).Value WS1.Cells(LR + 1, 14) = WS.Range("c16").Offset(1, 5).Value WS1.Cells(LR + 1, 15) = WS.Range("c16").Offset(1, 6).Value End If If WS.Cells(18, 3).Value <> "" Then WS1.Cells(LR + 2, 2) = WS.Range("d4").Value WS1.Cells(LR + 2, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 2, 3) = WS.Range("f2").Value WS1.Cells(LR + 2, 4) = WS.Range("f6").Value WS1.Cells(LR + 2, 5) = WS.Range("d8") WS1.Cells(LR + 2, 6) = WS.Range("h8") WS1.Cells(LR + 2, 7) = WS.Range("d10") WS1.Cells(LR + 2, 8) = WS.Range("d12") WS1.Cells(LR + 2, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 2, 9) = WS.Range("c16").Offset(2, 0).Value WS1.Cells(LR + 2, 10) = WS.Range("c16").Offset(2, 1).Value WS1.Cells(LR + 2, 11) = WS.Range("c16").Offset(2, 2).Value WS1.Cells(LR + 2, 12) = WS.Range("c16").Offset(2, 3).Value WS1.Cells(LR + 2, 13) = WS.Range("c16").Offset(2, 4).Value WS1.Cells(LR + 2, 14) = WS.Range("c16").Offset(2, 5).Value WS1.Cells(LR + 2, 15) = WS.Range("c16").Offset(2, 6).Value End If If WS.Cells(19, 3).Value <> "" Then WS1.Cells(LR + 3, 2) = WS.Range("d4").Value WS1.Cells(LR + 3, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 3, 3) = WS.Range("f2").Value WS1.Cells(LR + 3, 4) = WS.Range("f6").Value WS1.Cells(LR + 3, 5) = WS.Range("d8") WS1.Cells(LR + 3, 6) = WS.Range("h8") WS1.Cells(LR + 3, 7) = WS.Range("d10") WS1.Cells(LR + 3, 8) = WS.Range("d12") WS1.Cells(LR + 3, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 3, 9) = WS.Range("c16").Offset(3, 0).Value WS1.Cells(LR + 3, 10) = WS.Range("c16").Offset(3, 1).Value WS1.Cells(LR + 3, 11) = WS.Range("c16").Offset(3, 2).Value WS1.Cells(LR + 3, 12) = WS.Range("c16").Offset(3, 3).Value WS1.Cells(LR + 3, 13) = WS.Range("c16").Offset(3, 4).Value WS1.Cells(LR + 3, 14) = WS.Range("c16").Offset(3, 5).Value WS1.Cells(LR + 3, 15) = WS.Range("c16").Offset(3, 6).Value End If If WS.Cells(20, 3).Value <> "" Then WS1.Cells(LR + 4, 2) = WS.Range("d4").Value WS1.Cells(LR + 4, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 4, 3) = WS.Range("f2").Value WS1.Cells(LR + 4, 4) = WS.Range("f6").Value WS1.Cells(LR + 4, 5) = WS.Range("d8") WS1.Cells(LR + 4, 6) = WS.Range("h8") WS1.Cells(LR + 4, 7) = WS.Range("d10") WS1.Cells(LR + 4, 8) = WS.Range("d12") WS1.Cells(LR + 4, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 4, 9) = WS.Range("c16").Offset(4, 0).Value WS1.Cells(LR + 4, 10) = WS.Range("c16").Offset(4, 1).Value WS1.Cells(LR + 4, 11) = WS.Range("c16").Offset(4, 2).Value WS1.Cells(LR + 4, 12) = WS.Range("c16").Offset(4, 3).Value WS1.Cells(LR + 4, 13) = WS.Range("c16").Offset(4, 4).Value WS1.Cells(LR + 4, 14) = WS.Range("c16").Offset(4, 5).Value WS1.Cells(LR + 4, 15) = WS.Range("c16").Offset(4, 6).Value End If If WS.Cells(21, 3).Value <> "" Then WS1.Cells(LR + 5, 2) = WS.Range("d4").Value WS1.Cells(LR + 5, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 5, 3) = WS.Range("f2").Value WS1.Cells(LR + 5, 4) = WS.Range("f6").Value WS1.Cells(LR + 5, 5) = WS.Range("d8") WS1.Cells(LR + 5, 6) = WS.Range("h8") WS1.Cells(LR + 5, 7) = WS.Range("d10") WS1.Cells(LR + 5, 8) = WS.Range("d12") WS1.Cells(LR + 5, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 5, 9) = WS.Range("c16").Offset(5, 0).Value WS1.Cells(LR + 5, 10) = WS.Range("c16").Offset(5, 1).Value WS1.Cells(LR + 5, 11) = WS.Range("c16").Offset(5, 2).Value WS1.Cells(LR + 5, 12) = WS.Range("c16").Offset(5, 3).Value WS1.Cells(LR + 5, 13) = WS.Range("c16").Offset(5, 4).Value WS1.Cells(LR + 5, 14) = WS.Range("c16").Offset(5, 5).Value WS1.Cells(LR + 5, 15) = WS.Range("c16").Offset(5, 6).Value End If If WS.Cells(22, 3).Value <> "" Then WS1.Cells(LR + 6, 2) = WS.Range("d4").Value WS1.Cells(LR + 6, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 6, 3) = WS.Range("f2").Value WS1.Cells(LR + 6, 4) = WS.Range("f6").Value WS1.Cells(LR + 6, 5) = WS.Range("d8") WS1.Cells(LR + 6, 6) = WS.Range("h8") WS1.Cells(LR + 6, 7) = WS.Range("d10") WS1.Cells(LR + 6, 8) = WS.Range("d12") WS1.Cells(LR + 6, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 6, 9) = WS.Range("c16").Offset(6, 0).Value WS1.Cells(LR + 6, 10) = WS.Range("c16").Offset(6, 1).Value WS1.Cells(LR + 6, 11) = WS.Range("c16").Offset(6, 2).Value WS1.Cells(LR + 6, 12) = WS.Range("c16").Offset(6, 3).Value WS1.Cells(LR + 6, 13) = WS.Range("c16").Offset(6, 4).Value WS1.Cells(LR + 6, 14) = WS.Range("c16").Offset(6, 5).Value WS1.Cells(LR + 6, 15) = WS.Range("c16").Offset(6, 6).Value End If If WS.Cells(23, 3).Value <> "" Then WS1.Cells(LR + 7, 2) = WS.Range("d4").Value WS1.Cells(LR + 7, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 7, 3) = WS.Range("f2").Value WS1.Cells(LR + 7, 4) = WS.Range("f6").Value WS1.Cells(LR + 7, 5) = WS.Range("d8") WS1.Cells(LR + 7, 6) = WS.Range("h8") WS1.Cells(LR + 7, 7) = WS.Range("d10") WS1.Cells(LR + 7, 8) = WS.Range("d12") WS1.Cells(LR + 7, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 7, 9) = WS.Range("c16").Offset(7, 0).Value WS1.Cells(LR + 7, 10) = WS.Range("c16").Offset(7, 1).Value WS1.Cells(LR + 7, 11) = WS.Range("c16").Offset(7, 2).Value WS1.Cells(LR + 7, 12) = WS.Range("c16").Offset(7, 3).Value WS1.Cells(LR + 7, 13) = WS.Range("c16").Offset(7, 4).Value WS1.Cells(LR + 7, 14) = WS.Range("c16").Offset(7, 5).Value WS1.Cells(LR + 7, 15) = WS.Range("c16").Offset(7, 6).Value End If If WS.Cells(24, 3).Value <> "" Then WS1.Cells(LR + 8, 2) = WS.Range("d4").Value WS1.Cells(LR + 8, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 8, 3) = WS.Range("f2").Value WS1.Cells(LR + 8, 4) = WS.Range("f6").Value WS1.Cells(LR + 8, 5) = WS.Range("d8") WS1.Cells(LR + 8, 6) = WS.Range("h8") WS1.Cells(LR + 8, 7) = WS.Range("d10") WS1.Cells(LR + 8, 8) = WS.Range("d12") WS1.Cells(LR + 8, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 8, 9) = WS.Range("c16").Offset(8, 0).Value WS1.Cells(LR + 8, 10) = WS.Range("c16").Offset(8, 1).Value WS1.Cells(LR + 8, 11) = WS.Range("c16").Offset(8, 2).Value WS1.Cells(LR + 8, 12) = WS.Range("c16").Offset(8, 3).Value WS1.Cells(LR + 8, 13) = WS.Range("c16").Offset(8, 4).Value WS1.Cells(LR + 8, 14) = WS.Range("c16").Offset(8, 5).Value WS1.Cells(LR + 8, 15) = WS.Range("c16").Offset(8, 6).Value End If If WS.Cells(25, 3).Value <> "" Then WS1.Cells(LR + 9, 2) = WS.Range("d4").Value WS1.Cells(LR + 9, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 9, 3) = WS.Range("f2").Value WS1.Cells(LR + 9, 4) = WS.Range("f6").Value WS1.Cells(LR + 9, 5) = WS.Range("d8") WS1.Cells(LR + 9, 6) = WS.Range("h8") WS1.Cells(LR + 9, 7) = WS.Range("d10") WS1.Cells(LR + 9, 8) = WS.Range("d12") WS1.Cells(LR + 9, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 9, 9) = WS.Range("c16").Offset(9, 0).Value WS1.Cells(LR + 9, 10) = WS.Range("c16").Offset(9, 1).Value WS1.Cells(LR + 9, 11) = WS.Range("c16").Offset(9, 2).Value WS1.Cells(LR + 9, 12) = WS.Range("c16").Offset(9, 3).Value WS1.Cells(LR + 9, 13) = WS.Range("c16").Offset(9, 4).Value WS1.Cells(LR + 9, 14) = WS.Range("c16").Offset(9, 5).Value WS1.Cells(LR + 9, 15) = WS.Range("c16").Offset(9, 6).Value End If If WS.Cells(26, 3).Value <> "" Then WS1.Cells(LR + 10, 2) = WS.Range("d4").Value WS1.Cells(LR + 10, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 10, 3) = WS.Range("f2").Value WS1.Cells(LR + 10, 4) = WS.Range("f6").Value WS1.Cells(LR + 10, 5) = WS.Range("d8") WS1.Cells(LR + 10, 6) = WS.Range("h8") WS1.Cells(LR + 10, 7) = WS.Range("d10") WS1.Cells(LR + 10, 8) = WS.Range("d12") WS1.Cells(LR + 10, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 10, 9) = WS.Range("c16").Offset(10, 0).Value WS1.Cells(LR + 10, 10) = WS.Range("c16").Offset(10, 1).Value WS1.Cells(LR + 10, 11) = WS.Range("c16").Offset(10, 2).Value WS1.Cells(LR + 10, 12) = WS.Range("c16").Offset(10, 3).Value WS1.Cells(LR + 10, 13) = WS.Range("c16").Offset(10, 4).Value WS1.Cells(LR + 10, 14) = WS.Range("c16").Offset(10, 5).Value WS1.Cells(LR + 10, 15) = WS.Range("c16").Offset(10, 6).Value End If If WS.Cells(27, 3).Value <> "" Then WS1.Cells(LR + 11, 2) = WS.Range("d4").Value WS1.Cells(LR + 11, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 11, 3) = WS.Range("f2").Value WS1.Cells(LR + 11, 4) = WS.Range("f6").Value WS1.Cells(LR + 11, 5) = WS.Range("d8") WS1.Cells(LR + 11, 6) = WS.Range("h8") WS1.Cells(LR + 11, 7) = WS.Range("d10") WS1.Cells(LR + 11, 8) = WS.Range("d12") WS1.Cells(LR + 11, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 11, 9) = WS.Range("c16").Offset(11, 0).Value WS1.Cells(LR + 11, 10) = WS.Range("c16").Offset(11, 1).Value WS1.Cells(LR + 11, 11) = WS.Range("c16").Offset(11, 2).Value WS1.Cells(LR + 11, 12) = WS.Range("c16").Offset(11, 3).Value WS1.Cells(LR + 11, 13) = WS.Range("c16").Offset(11, 4).Value WS1.Cells(LR + 11, 14) = WS.Range("c16").Offset(11, 5).Value WS1.Cells(LR + 11, 15) = WS.Range("c16").Offset(11, 6).Value End If If WS.Cells(28, 3).Value <> "" Then WS1.Cells(LR + 12, 2) = WS.Range("d4").Value WS1.Cells(LR + 12, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 12, 3) = WS.Range("f2").Value WS1.Cells(LR + 12, 4) = WS.Range("f6").Value WS1.Cells(LR + 12, 5) = WS.Range("d8") WS1.Cells(LR + 12, 6) = WS.Range("h8") WS1.Cells(LR + 12, 7) = WS.Range("d10") WS1.Cells(LR + 12, 8) = WS.Range("d12") WS1.Cells(LR + 12, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 12, 9) = WS.Range("c16").Offset(12, 0).Value WS1.Cells(LR + 12, 10) = WS.Range("c16").Offset(12, 1).Value WS1.Cells(LR + 12, 11) = WS.Range("c16").Offset(12, 2).Value WS1.Cells(LR + 12, 12) = WS.Range("c16").Offset(12, 3).Value WS1.Cells(LR + 12, 13) = WS.Range("c16").Offset(12, 4).Value WS1.Cells(LR + 12, 14) = WS.Range("c16").Offset(12, 5).Value WS1.Cells(LR + 12, 15) = WS.Range("c16").Offset(12, 6).Value End If If WS.Cells(29, 3).Value <> "" Then WS1.Cells(LR + 13, 2) = WS.Range("d4").Value WS1.Cells(LR + 13, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 13, 3) = WS.Range("f2").Value WS1.Cells(LR + 13, 4) = WS.Range("f6").Value WS1.Cells(LR + 13, 5) = WS.Range("d8") WS1.Cells(LR + 13, 6) = WS.Range("h8") WS1.Cells(LR + 13, 7) = WS.Range("d10") WS1.Cells(LR + 13, 8) = WS.Range("d12") WS1.Cells(LR + 13, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 13, 9) = WS.Range("c16").Offset(13, 0).Value WS1.Cells(LR + 13, 10) = WS.Range("c16").Offset(13, 1).Value WS1.Cells(LR + 13, 11) = WS.Range("c16").Offset(13, 2).Value WS1.Cells(LR + 13, 12) = WS.Range("c16").Offset(13, 3).Value WS1.Cells(LR + 13, 13) = WS.Range("c16").Offset(13, 4).Value WS1.Cells(LR + 13, 14) = WS.Range("c16").Offset(13, 5).Value WS1.Cells(LR + 13, 15) = WS.Range("c16").Offset(13, 6).Value End If If WS.Cells(30, 3).Value <> "" Then WS1.Cells(LR + 14, 2) = WS.Range("d4").Value WS1.Cells(LR + 14, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 14, 3) = WS.Range("f2").Value WS1.Cells(LR + 14, 4) = WS.Range("f6").Value WS1.Cells(LR + 14, 5) = WS.Range("d8") WS1.Cells(LR + 14, 6) = WS.Range("h8") WS1.Cells(LR + 14, 7) = WS.Range("d10") WS1.Cells(LR + 14, 8) = WS.Range("d12") WS1.Cells(LR + 14, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 14, 9) = WS.Range("c16").Offset(14, 0).Value WS1.Cells(LR + 14, 10) = WS.Range("c16").Offset(14, 1).Value WS1.Cells(LR + 14, 11) = WS.Range("c16").Offset(14, 2).Value WS1.Cells(LR + 14, 12) = WS.Range("c16").Offset(14, 3).Value WS1.Cells(LR + 14, 13) = WS.Range("c16").Offset(14, 4).Value WS1.Cells(LR + 14, 14) = WS.Range("c16").Offset(14, 5).Value WS1.Cells(LR + 14, 15) = WS.Range("c16").Offset(14, 6).Value End If If WS.Cells(31, 3).Value <> "" Then WS1.Cells(LR + 15, 2) = WS.Range("d4").Value WS1.Cells(LR + 15, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 15, 3) = WS.Range("f2").Value WS1.Cells(LR + 15, 4) = WS.Range("f6").Value WS1.Cells(LR + 15, 5) = WS.Range("d8") WS1.Cells(LR + 15, 6) = WS.Range("h8") WS1.Cells(LR + 15, 7) = WS.Range("d10") WS1.Cells(LR + 15, 8) = WS.Range("d12") WS1.Cells(LR + 15, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 15, 9) = WS.Range("c16").Offset(15, 0).Value WS1.Cells(LR + 15, 10) = WS.Range("c16").Offset(15, 1).Value WS1.Cells(LR + 15, 11) = WS.Range("c16").Offset(15, 2).Value WS1.Cells(LR + 15, 12) = WS.Range("c16").Offset(15, 3).Value WS1.Cells(LR + 15, 13) = WS.Range("c16").Offset(15, 4).Value WS1.Cells(LR + 15, 14) = WS.Range("c16").Offset(15, 5).Value WS1.Cells(LR + 15, 15) = WS.Range("c16").Offset(15, 6).Value End If If WS.Cells(32, 3).Value <> "" Then WS1.Cells(LR + 16, 2) = WS.Range("d4").Value WS1.Cells(LR + 16, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 16, 3) = WS.Range("f2").Value WS1.Cells(LR + 16, 4) = WS.Range("f6").Value WS1.Cells(LR + 16, 5) = WS.Range("d8") WS1.Cells(LR + 16, 6) = WS.Range("h8") WS1.Cells(LR + 16, 7) = WS.Range("d10") WS1.Cells(LR + 16, 8) = WS.Range("d12") WS1.Cells(LR + 16, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 16, 9) = WS.Range("c16").Offset(16, 0).Value WS1.Cells(LR + 16, 10) = WS.Range("c16").Offset(16, 1).Value WS1.Cells(LR + 16, 11) = WS.Range("c16").Offset(16, 2).Value WS1.Cells(LR + 16, 12) = WS.Range("c16").Offset(16, 3).Value WS1.Cells(LR + 16, 13) = WS.Range("c16").Offset(16, 4).Value WS1.Cells(LR + 16, 14) = WS.Range("c16").Offset(16, 5).Value WS1.Cells(LR + 16, 15) = WS.Range("c16").Offset(16, 6).Value End If If WS.Cells(33, 3).Value <> "" Then WS1.Cells(LR + 17, 2) = WS.Range("d4").Value WS1.Cells(LR + 17, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 17, 3) = WS.Range("f2").Value WS1.Cells(LR + 17, 4) = WS.Range("f6").Value WS1.Cells(LR + 17, 5) = WS.Range("d8") WS1.Cells(LR + 17, 6) = WS.Range("h8") WS1.Cells(LR + 17, 7) = WS.Range("d10") WS1.Cells(LR + 17, 8) = WS.Range("d12") WS1.Cells(LR + 17, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 17, 9) = WS.Range("c16").Offset(17, 0).Value WS1.Cells(LR + 17, 10) = WS.Range("c16").Offset(17, 1).Value WS1.Cells(LR + 17, 11) = WS.Range("c16").Offset(17, 2).Value WS1.Cells(LR + 17, 12) = WS.Range("c16").Offset(17, 3).Value WS1.Cells(LR + 17, 13) = WS.Range("c16").Offset(17, 4).Value WS1.Cells(LR + 17, 14) = WS.Range("c16").Offset(17, 5).Value WS1.Cells(LR + 17, 15) = WS.Range("c16").Offset(17, 6).Value End If If WS.Cells(34, 3).Value <> "" Then WS1.Cells(LR + 18, 2) = WS.Range("d4").Value WS1.Cells(LR + 18, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 18, 3) = WS.Range("f2").Value WS1.Cells(LR + 18, 4) = WS.Range("f6").Value WS1.Cells(LR + 18, 5) = WS.Range("d8") WS1.Cells(LR + 18, 6) = WS.Range("h8") WS1.Cells(LR + 18, 7) = WS.Range("d10") WS1.Cells(LR + 18, 8) = WS.Range("d12") WS1.Cells(LR + 18, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 18, 9) = WS.Range("c16").Offset(18, 0).Value WS1.Cells(LR + 18, 10) = WS.Range("c16").Offset(18, 1).Value WS1.Cells(LR + 18, 11) = WS.Range("c16").Offset(18, 2).Value WS1.Cells(LR + 18, 12) = WS.Range("c16").Offset(18, 3).Value WS1.Cells(LR + 18, 13) = WS.Range("c16").Offset(18, 4).Value WS1.Cells(LR + 18, 14) = WS.Range("c16").Offset(18, 5).Value WS1.Cells(LR + 18, 15) = WS.Range("c16").Offset(18, 6).Value End If If WS.Cells(35, 3).Value <> "" Then WS1.Cells(LR + 19, 2) = WS.Range("d4").Value WS1.Cells(LR + 19, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 19, 3) = WS.Range("f2").Value WS1.Cells(LR + 19, 4) = WS.Range("f6").Value WS1.Cells(LR + 19, 5) = WS.Range("d8") WS1.Cells(LR + 19, 6) = WS.Range("h8") WS1.Cells(LR + 19, 7) = WS.Range("d10") WS1.Cells(LR + 19, 8) = WS.Range("d12") WS1.Cells(LR + 19, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 19, 9) = WS.Range("c16").Offset(19, 0).Value WS1.Cells(LR + 19, 10) = WS.Range("c16").Offset(19, 1).Value WS1.Cells(LR + 19, 11) = WS.Range("c16").Offset(19, 2).Value WS1.Cells(LR + 19, 12) = WS.Range("c16").Offset(19, 3).Value WS1.Cells(LR + 19, 13) = WS.Range("c16").Offset(19, 4).Value WS1.Cells(LR + 19, 14) = WS.Range("c16").Offset(19, 5).Value WS1.Cells(LR + 19, 15) = WS.Range("c16").Offset(19, 6).Value End If If WS.Cells(36, 3).Value <> "" Then WS1.Cells(LR + 20, 2) = WS.Range("d4").Value WS1.Cells(LR + 20, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 20, 3) = WS.Range("f2").Value WS1.Cells(LR + 20, 4) = WS.Range("f6").Value WS1.Cells(LR + 20, 5) = WS.Range("d8") WS1.Cells(LR + 20, 6) = WS.Range("h8") WS1.Cells(LR + 20, 7) = WS.Range("d10") WS1.Cells(LR + 20, 8) = WS.Range("d12") WS1.Cells(LR + 20, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 20, 9) = WS.Range("c16").Offset(20, 0).Value WS1.Cells(LR + 20, 10) = WS.Range("c16").Offset(20, 1).Value WS1.Cells(LR + 20, 11) = WS.Range("c16").Offset(20, 2).Value WS1.Cells(LR + 20, 12) = WS.Range("c16").Offset(20, 3).Value WS1.Cells(LR + 20, 13) = WS.Range("c16").Offset(20, 4).Value WS1.Cells(LR + 20, 14) = WS.Range("c16").Offset(20, 5).Value WS1.Cells(LR + 20, 15) = WS.Range("c16").Offset(20, 6).Value End If If WS.Cells(37, 3).Value <> "" Then WS1.Cells(LR + 21, 2) = WS.Range("d4").Value WS1.Cells(LR + 21, 2).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 21, 3) = WS.Range("f2").Value WS1.Cells(LR + 21, 4) = WS.Range("f6").Value WS1.Cells(LR + 21, 5) = WS.Range("d8") WS1.Cells(LR + 21, 6) = WS.Range("h8") WS1.Cells(LR + 21, 7) = WS.Range("d10") WS1.Cells(LR + 21, 8) = WS.Range("d12") WS1.Cells(LR + 21, 8).NumberFormat = "dd-mm-yyyy" WS1.Cells(LR + 21, 9) = WS.Range("c16").Offset(21, 0).Value WS1.Cells(LR + 21, 10) = WS.Range("c16").Offset(21, 1).Value WS1.Cells(LR + 21, 11) = WS.Range("c16").Offset(21, 2).Value WS1.Cells(LR + 21, 12) = WS.Range("c16").Offset(21, 3).Value WS1.Cells(LR + 21, 13) = WS.Range("c16").Offset(21, 4).Value WS1.Cells(LR + 21, 14) = WS.Range("c16").Offset(21, 5).Value WS1.Cells(LR + 21, 15) = WS.Range("c16").Offset(21, 6).Value End If Application.ScreenUpdating = True End Sub دعونا نتطرق الى شرح الكود Application.ScreenUpdating = False وقف اهتزاز الشاشه وذلك من اجل سرعه تنفيذ الكود Dim LR As Long تعريف المتغير LR على انه متغير طويل المدى Dim WS As Worksheet Dim WS1 As Worksheet تعريف كلا من المتغير ws والمتغير ws1 على انهما شيت اكسيل Set WS = Worksheets("INVOICE") تحديد المتغير ws وتعريفه على انه عباره عن الشيت المسمى ب invoice Set WS1 = Worksheets("INVOICE DATA") تحديد المتغير ws1 وتعريفه على انه عباره عن الشيت المسمى ب INVOICE DATA LR = WS1.Range("e10000").End(xlUp).Row + 1 هنا يتم تحديد المتغير LR وتعريفه على انه عباره عن اخر خليه بها بيانات فى العمود E (اسم العميل)مضافا اليها خليه واحده (اى اول خليه فارغه فى العمود E) وذلك حتى الخليه E10000 وذلك فى الشيت المعرف ب WS1 اى فى شيت INVOICE DATA LR1 = WS1.Range("c10000").End(xlUp).Row + 1 هنا يتم تحديد المتغير LR1 وتعريفه على انه عباره عن اخر خليه بها بيانات فى العمود C (رقم الفاتوره)مضافا اليها خليه واحده (اى اول خليه فارغه فى العمود C) وذلك حتى الخليه C10000 وذلك فى الشيت المعرف ب WS1 اى فى شيت INVOICE DATA For r = 3 To LR1 هنا يتم استخدام الخلقه التكراريه بدايه من السطر الثالث وحتى اخر سطر به بيانات فى شيت INVOICE DATA If WS1.Cells(r, 3) = WS.Range("f2") Then MsgBox "This invoice already exist, No shift will done": Exit Sub هنا نقول انه اذا كان المتغير R اى بداية من السطر3 وحتى اخر سطر به بيانات فى شيت INVOICE DATA فى العمود الثالث يساوى الخليه F2 فى شيت INVOICE يتم اظهار الرساله التى تفيد بأن الرقم المدخل موجود من قبل بمعنى انه فى حالة كتابة الرقم 5 مثلا فى الخليه F2 وهذا الرقم موجود فى احدى الخلايا بداية من السطر الثالث وحتى اخر سطر به بيانات فى العمود 3 يتم ظهور الرساله التى تفيد بان الرقم موجود من قبل Exit Sub الخروج من الحلقه التكراريه وعدم تنفيذ شئ بعد ذلك NEXT طالما بدأنا ب FOR اذا لابد من اقفال الكود ب NEXT وبذلك نكون قد انتهينا من وضع الكود الخاص بعدم السماح بتكرار رقم القاتوره الان نبدأ بوضع شروط الترحيل If WS.Range("d4").Value = "" Then MsgBox "enter invoice date": Exit Sub فى حالة فراغ الخليه d4 فى شيت invoice تظهر رساله تفيد بانه يجب كتابة التاريخ ثم نستخدم Exit Sub للخروخ من الكود وعدم تنفيذ شئ فى حالة الفراغ If WS.Cells(16, 3).Value = "" Then MsgBox "حد ادنى صف واحد لكى يسمح للفاتورة بالترحيل ": Exit Sub هنا بنقول انه فى حالة ان الخليه الواقعه فى السطر 16 وفى العمود 3 فى شيت invoice اى الخليه c16 فارغه يتم ظهور رساله تفيد بانه لايمكن الترحيل الا بكتابة سطر على الاقل من الفاتوره ثم نستخدم Exit Sub للخروج من الكود وعدم تنفيذ شئ فى حالة الفراغ ثم بعد تحقق الشرطين السابقين يبدأ الترحيل فاذا نظرنا الى الفاتوره سنجد انها مكونه من جزئين الجزء الاول وهو الجزء العلوى الذى يحتوى على --رقم الفاتوره-تاريخ الفاتوره-كود العميل-اسم العميل-عنوان العميل-ت الاستحقاق الجزء الثانى وهو الجزء السفلى من الفاتوره المكون من صفوف الفاتوره والتى عددها 22 صف وحيث اننا نريد ترحيل بيانات الفاتوره العلويه مع كل سطر من سطور الفاتوره التى فى الجزء السفلى فسوف يتم وضع شروط لترحيل كل سطر وبذلك سيكون لدينا 22 شرط كل شرط مرتبط بسطر معين وطبعا لعدم الاطاله فى الشرح فسيتم تناول شرح كيفية ترحيل السطر الاول فقط ثم يمكنكم تطبيق الشرح على باقى السطور If WS.Cells(16, 3).Value <> "" Then هذا هو الشرط الاول بنقول فيه انه فى حالة ان الخليه الواقعه فى السطر 16 وفى العمود 3 فى شيت invoice اى الخليه c16 غير فارغه يتم الاتى بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان اول عمود سيتم الترحيل اليه هو عمود تاريخ الفاتوره لذلك ستم وضع الكود الذى يمكننا من نقل قيمة الخليه التى بها تاريخ الفاتوره فى شيت INVOICE الى العمود الخاص بالتاريخ فى شيت INVOICE DATA WS1.Cells(LR, 2) = WS.Range("d4").Value طبعا هنا بنذكر ان المتغير LR تم تعريفه على انه الوصول الى اخر خليه بها بيانات اى اول خليه فارغه فى العمود e عمود اسم العميل وبالنظر الى شيت INVOICE DATA سنجد ان اول خليه فارغه هى B3 اى ان الترحيل سيكون بداية من السطر 3 وبالتالى فهنا نقول ان اول خليه فارغه فى العمود 2 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه D4 فى شيت WS اى فى شيت INVOICE ثم نقوم بوضع كود اخر لاظهار القيم المرحله الى عمود التاريخ على انها تاريخ كما فى الكود الاتى WS1.Cells(LR, 2).NumberFormat = "dd-mm-yyyy" كما هو موضح من شكل الكود انه يتم عمل تنسيق للعمود2 فى شيت INVOICE DATA على انها تاريخ يظهر بالشكل الاتى سنه-شهر-يوم بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان ثانى عمود سيتم الترحيل اليه هو عمود رقم الفاتوره لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه التى بها رقم الفاتوره فى شيت INVOICE الى العمود الخاص برقم الفاتوره فى شيت INVOICE DATA WS1.Cells(LR, 3) = WS.Range("f2").Value وبالتالى فهنا نقول ان اول خليه فارغه فى العمود 3 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمةالخليه F2 فى شيت WS اى فى شيت INVOICE بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان ثالث عمود سيتم الترحيل اليه هو عمود كود العميل لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه التى بها كود العميل فى شيت INVOICE الى العمود الخاص بكود العميل فى شيت INVOICE DATA WS1.Cells(LR, 4) = WS.Range("f6").Value وبالتالى فهنا نقول ان اول خليه فارغه فى العمود 4 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمةالخليه F6 فى شيت WS اى فى شيت INVOICE بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان رابع عمود سيتم الترحيل اليه هو عمود اسم العميل لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه التى بها اسم العميل فى شيت INVOICE الى العمود الخاص اسم العميل فى شيت INVOICE DATA WS1.Cells(LR, 5) = WS.Range("d8") وبالتالى فهنا نقول ان اول خليه فارغه فى العمود 5 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه D8 فى شيت WS اى فى شيت INVOICE بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان خامس عمود سيتم الترحيل اليه هو عمود تليفون العميل لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه التى بها تليفون العميل فى شيت INVOICE الى العمود الخاص تليفون العميل فى شيت INVOICE DATA WS1.Cells(LR, 6) = WS.Range("h8") وبالتالى فهنا نقول ان اول خليه فارغه فى العمود 6 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه H8 فى شيت WS اى فى شيت INVOICE بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان سادس عمود سيتم الترحيل اليه هو عمود عنوان العميل لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه التى بها عنوان العميل فى شيت INVOICE الى العمود الخاص بعنوان العميل فى شيت INVOICE DATA WS1.Cells(LR, 7) = WS.Range("d10") وبالتالى فهنا نقول ان اول خليه فارغه فى العمود 7 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه D10 فى شيت WS اى فى شيت INVOICE بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان سابع عمود سيتم الترحيل اليه هو عمود ت الاستحقاق لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه التى بها ت الاستحقاق فى شيت INVOICE الى العمود الخاص بتاريخ الاستحقاق فى شيت INVOICE DATA WS1.Cells(LR, 8) = WS.Range("d12") وبالتالى فهنا نقول ان اول خليه فارغه فى العمود 8 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه D12 فى شيت WS اى فى شيت INVOICE هنا نكون انتهينا من ترحيل الصفوف العلويه الان نبدأ بترحيل الجزء الثانى من الفاتوره وهو ترحيل سطورها السطر الاول بالنظر الى الفاتوره نجد ان اول سطر فى الفاتوره يبدأ من السطر 16 فى شيت invoice بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان ثامن عمود سيتم الترحيل اليه هو عمود كود الصنف لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه فى السطر الاول من سطور الفاتوره التى تبدأ من السطر 16 وفى العمود الثانى عمود( كود الصنف )من اعمده الفاتوره التى بها بيانات وذلك فى شيت INVOICE الى شيت INVOICE DATA فى عمود كود الصنف WS1.Cells(LR, 9) = WS.Range("c16").Offset(0, 0).Value وبالتالى فهنا نقول ان اول خليه فارغه فى العمود 9 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه c16 فى شيت WS اى فى شيت INVOICE بالنظر الى الفاتوره نجد ان اول سطر يبدأ من السطر 16 فى شيت invoice بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان تاسع عمود سيتم الترحيل اليه هو عمود اسم الصنف لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه فى السطر الاول من سطور الفاتوره التى تبدأ من السطر 16 وفى العمود الثالث عمود( اسم الصنف )من اعمده الفاتوره التى بها بيانات وذلك فى شيت INVOICE الى شيت INVOICE DATA فى عمود اسم الصنف WS1.Cells(LR, 10) = WS.Range("c16").Offset(0, 1).Value وبالتالى فهنا نقول ان اول خليه فارغه فى العمود 10 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمةالخليه c16 فى شيت WS مع الازاحه بقيمة نفس السطر وعمود اضافى (اى فى شيت INVOICE ) بمعنى اننا لو افترضنا ان اول خليه فارغه فى شيت INVOICE DATA فى العمود 10 هى j3 اذا قيمة J3 تساوى قيمة الخليه c16 مع الازاحه لنفس السطر اى مازلنا فى c16 مع الازاحه عمود واحد اذا اصبحنا فى d16 لتصبح قيمة الخليه j3 تساوى قيمة الخليه d16 بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان العمود العاشر الذى سيتم الترحيل اليه هو عمود الوحده لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه فى السطر الاول من سطور الفاتوره التى تبدأ من السطر 16 وفى العمود الرابع (الوحده )من اعمده الفاتوره التى بها بيانات وذلك فى شيت INVOICE الى شيت INVOICE DATA فى عمود الوحده WS1.Cells(LR, 11) = WS.Range("c16").Offset(0, 2).Value وبالتالى فهنا نقول ان اول خليه فارغه فى العمود 11 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه c16 فى شيت WS مع الازاحه بقيمة نفس السطر وقيمة عمودين اضافين (اى فى شيت INVOICE ) بمعنى اننا لو افترضنا ان اول خليه فارغه فى شيت INVOICE DATA فى العمود 11 هى k3 اذا قيمة k3 تساوى قيمة الخليه c16 مع الازاحه لنفس السطر اى مازلنا فى c16 مع الازاحه عمودين اذا اصبحنا فى e16 لتصبح قيمة الخليه k3 تساوى قيمة الخليه e16 بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان العمود الحادى العاشر الذى سيتم الترحيل اليه هو عمود الوحده لذلك سبتم وضع الكود الذى يمكننا من نقل قيمة الخليه فى السطر الاول من سطور الفاتوره التى تبدأ من السطر 16 وفى العمود الخامس ( الكميه )من اعمده الفاتوره التى بها بيانات وذلك فى شيت INVOICE الى شيت INVOICE DATA فى عمود الكميه WS1.Cells(LR, 12) = WS.Range("c16").Offset(0, 3).Value وبالتالى فهنا نقول ان اول خليه فارغه فى العمود 12 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه c16 فى شيت WS مع الازاحه بقيمة نفس السطر وقيمة ثلاثه اعمده اضافيه (اى فى شيت INVOICE ) بمعنى اننا لو افترضنا ان اول خليه فارغه فى شيت INVOICE DATA فى العمود 12 هى L3 اذا قيمة L3 تساوى قيمة الخليه c16 مع الازاحه لنفس السطر اى مازلنا فى c16 مع الازاحه ثلاثه اعمده اذا اصبحنا فى F16 لتصبح قيمة الخليه L3 تساوى قيمة الخليه F16 بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان العمود الثانى العاشر الذى سيتم الترحيل اليه هو عمود السعر لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه فى السطر الاول من سطور الفاتوره التى تبدأ من السطر 16 وفى العمود السادس ( السعر )من اعمده الفاتوره التى بها بيانات وذلك فى شيت INVOICE الى شيت INVOICE DATA فى عمود السعر WS1.Cells(LR, 13) = WS.Range("c16").Offset(0, 4).Value وبالتالى فهنا نقول ان اول خليه فارغه فى العمود 13 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه c16 فى شيت WS مع الازاحه بقيمة نفس السطر وقيمة اربعة اعمده اضافيه (اى فى شيت INVOICE ) بمعنى اننا لو افترضنا ان اول خليه فارغه فى شيت INVOICE DATA فى العمود 13 هى M3 اذا قيمة M3 تساوى قيمة الخليه c16 مع الازاحه لنفس السطر اى مازلنا فى c16 مع الازاحه اربعة اعمده اذا اصبحنا فى G16 لتصبح قيمة الخليه M3 تساوى قيمة الخليه G16 بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان العمود الثالث عشر الذى سيتم الترحيل اليه هو عمود القيمه لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه فى السطر الاول من سطور الفاتوره التى تبدأ من السطر 16 وفى العمود السابع ( القيمه )من اعمده الفاتوره التى بها بيانات وذلك فى شيت INVOICE الى شيت INVOICE DATA فى عمود القيمه WS1.Cells(LR, 14) = WS.Range("c16").Offset(0, 5).Value وبالتالى فهنا نقول ان اول خليه فارغه فى العمود 14 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه c16 فى شيت WS مع الازاحه بقيمة نفس السطر وقيمة خمسة اعمده اضافيه (اى فى شيت INVOICE ) بمعنى اننا لو افترضنا ان اول خليه فارغه فى شيت INVOICE DATA فى العمود 14 هى N3 اذا قيمة N3 تساوى قيمة الخليه c16 مع الازاحه لنفس السطر اى مازلنا فى c16 مع الازاحه خمسة اعمده اذا اصبحنا فى H16 لتصبح قيمة الخليه N3 تساوى قيمة الخليه H16 بالنظر الى شيت INVOICE DATA وهو الشيت الذى سيتم ترحيل بيانات الفاتوره اليه نجد ان العمود الرابع عشر الذى سيتم الترحيل اليه هو عمود الملاحظات لذلك سيتم وضع الكود الذى يمكننا من نقل قيمة الخليه فى السطر الاول من سطور الفاتوره التى تبدأ من السطر 16 وفى العمود السابع ( الملاحظات )من اعمده الفاتوره التى بها بيانات وذلك فى شيت INVOICE الى شيت INVOICE DATA فى عمود الملاحظات WS1.Cells(LR, 15) = WS.Range("c16").Offset(0, 6).Value وبالتالى فهنا نقول ان اول خليه فارغه فى العمود 15 فى شيت WS1 اى فى شيت INVOICE DATA تساوى قيمة الخليه c16 فى شيت WS مع الازاحه بقيمة نفس السطر وقيمة ستة اعمده اضافيه (اى فى شيت INVOICE ) بمعنى اننا لو افترضنا ان اول خليه فارغه فى شيت INVOICE DATA فى العمود 15 هى O3 اذا قيمة O3 تساوى قيمة الخليه c16 مع الازاحه لنفس السطر اى مازلنا فى c16 مع الازاحه ستة اعمده اذا اصبحنا فى i16 لتصبح قيمة الخليه O3 تساوى قيمة الخليه i16 الكلام ده ينطبق على باقى الكود اود ان انبه على شئ من اجل التسهيل فى فهم باقى الكود مثلا لو افترضنا ان اول خليه فارغه فى شيت invoice data فى العمود c هى c3 فمن اجل ادخال البيانات فى هذه الخليه نستخدم الكود WS1.Cells(LR وطبعا احنا معرفين LR فى الكود على انه الوصول الى اخر خليه بها بيانات مضافا اليها خليه واحده اى الوصول الى اول خليه فارغه اى C3 فلما نقول ان WS1.Cells(LR, 3) = WS.Range("f2").Value وبما ان C2هى اخر خليه بها بيانات فلما نضيف عليها خليه تصبح C3 اول خليه فارغه تساوى قيمة الخليه F2 ولو ان قيمة F2 تساوى 10 اى ان C3 اصبح بها الرقم 10 ايضا فلو كتبنا السطر التالى WS1.Cells(LR+1 فهذا يعنى الوصول الى اخر بخليه بها بيانات مضافا اليها خليه اخرى وبما ان C3 ُاصبح بها الرقم 10 اذا سنضيف خليه اخرى على الخليه c3 وذلك باضافة الرقم 1 لتصبح C4 او بمعنى اخر الوصول الى ثانى خليه فارغه بعد اخر خليه بها بيانات وحيث ان اخر خليه كان بها بيانات هى C2 فان ثانى خليه بعدها هى C4 وهكذا ............................................................................................................................................................................................................................ الان نقوم بتجربه الملف المرفق لرؤيه عمل الكود على حده شاهد المرفق 5-EXCEL ----------------------------------------------------------------------------------- الان قد انتهينا من شرح الدرس الثانى ( خ ) الكود الخامس---كود يقوم بترحيل بيانات الفاتوره الى شيت invoice date اتمنى ان اكون قد وفقت فى الشرح تقبلوا تحياتى 5-EXCEL.rar

بسم الله الرحمن الرحيم " الْحَمْدُ لِلّهِ الَّذِي هَدَانَا لِهَذَا وَمَا كُنَّا لِنَهْتَدِيَ لَوْلا أَنْ هَدَانَا اللّهُ " ============================================================ برنامج الكنترول المدرسى 2017 من فضلك أكمل قراءة الموضوع ــ روابط التحميل آخر الموضوع نبذة عن البرنامج أولاً ـ تم تصميم وإعداد هذا البرنامج باستخدام Office 2010 ، لذلك فالبرنامج لا يعمل على Office 2003 ثانيًا ـ يعتبر هذا البرنامج الاصدار الثانى بعد نجاح الاصدار الأول بفضل الله ـ عز وجل ـ و الذى أعجب به كثير من رواد الكنترولات لبساطته وسهولة التعامل معه ولكن وجد به بعض التعديلات التى وجبت علىّ متابعتها وتعديلها وإظهار الأفضل والأدق ، فكان هذا الاصدار الثانى . الجديد في هذا الاصدار : 1ـ استخدام تصميمات جذابة سواء في أوراق العمل أو في وجهات البرنامج المختلفة . 2ـ يتم الانتقال بين أوراق الكنترول باستخدام أزرار داخلية المساعدة و من خلال الوجهات للدخول غلى أوراق العمل . 3 ـ تم تخصيص ورقة لتجهيز وإعداد وضبط وفرز أسماء التلاميذ وترتيبهم ابجديا ( الذكور أولا ) أو ( الإناث أولا) يتم الترحيل منها إلى البيانات الأساسية للطلاب 4ـ وتم إضافة خيار جديد داخل قائمة ( حالة الطالب ) وهو منقطع العام السابق إذا كان الطالب غائب عن الامتحان العام السابق فقط ( منقطع عام واحد ) وذلك لحساب عدد الطلاب الموقوف قيدهم للانقطاع عامين بعد الدور الثانى . 5 ـ في كثير من أوراق العمل متابعة تعليمات التشغيل من خلال ( ملاحظات ) موجودة داخل كل ورقة عمل . 6 ـ وجود إحصائيات داخل أوراق العمل للمساعدة مسئول الكنترول على متابعة العمل. أولا بأول 7ـ كشوف المناداة يحتوى كل كشف على لجنتين من نفس الصف الدراسى . 8 ـ الجدول وأرقام الجلوس : يوجد بالجدول الأول بالورقة قوائم منسدلة لملء بيانات الجدول فمثلا : خانة اليوم .... اضغط ستجد قائمة بأيام الأسبوع. خانة المادة ... اضغط ستجد قائمة بأسماء المواد الدراسية . خانة الزمن .. اضغط ستجد قائمة بأوقات الامتحان المتاحة . 9 ـ يتم ترحيل الطلاب الراسبين أو الناجحين تلقائيًا إلى أوراق منفصلة بهم خاصة 10 ـ زادت دقـــة الاحصائيات عن الاصدار الأول وتعديل ما بها من قصور بسيط . 11 ـ تم استخراج نسبة 65 % للطلاب الناجحين للمواد مرفقة داخل ورقة الاحصاء . 12 ـ تم تعديل شروط الحصول على الأوائل لتكون أكثر دقــة وذلك بالشروط المنصوص عليها وهى : الأكبر مجموع ثم الأصغر سنا في حالة تساوى المجموع ثم الترتيب الأبجدى في حالة تساوى المجموع والسن . ـ وظهور كلمة مكرر في حالة التساوى . 13 ـ يمكن التحكم في عدد الأوائل 30 أو 20 أو 10 حسب الرغبة وذلك باستخدام أزرار معينة موجودة بورقة العمل . 14 ـ تم تعديل هيكل تصميم الشهادات ليوافق التصميم المتعارف عليه والمنصوص عليه . 15 ـ يمكن الحصول على شهادات بأكثر من شكل كما يلى :_ __ شهادة التيرم الأول بمجموع المواد الأساسية فقط __ شهادة التيرم الأول بالمجموع الكلى بالأنشطة ـ __ شهادة التيرم الأول بدجات الامتحان التحريرى ـ __ شهادة التيرم الثانى بمجموع المواد الأساسية فقط __ شهادة التيرم الثانى بالمجموع الكلى بالأنشطة ـ __ شهادة التيرم الثانى بدجات الامتحان التحريرى ـ 16 ـ : الدور الثانى : _ يتم ترحيل البيانات من شيت راسبين آخر العام إلى ورقة البيانات الأساسية للطلاب الدور الثانى تلقائيا . 17 ـ يتم ترحيل الدرجات الناجحة فقط إلى كشف رصد الامتحان التحريرى الدور الثانى ويتبقى خانات فارغة التى تخص الدرجات الراسبة التى يتم الامتحان فيها ورصدها . 18 ـ يوجد إحصاء ختامى لنهاية العام الدراسى . 19 ـ يوجد أوراق منفصلة كل على حده لما يأتى : _ أ ـ كشف الناجحين بعد الدور الثانى . ب ـ كشف الراسبين بعد الدور الثانى . ج ـ كشف المنقولين بحكم القانون بعد الدور الثانى . د ـ كشف الموقوف قيدهم للانقطاع عامين بعد الدور الثانى . 20 ـ تم إضافة أوراق جديدة للكنترول للمساعدة على أداء العمل : وهذه الأوراق هى أ ـ كشف إجمال براسبين التيرم الثانى لتوقيع ولى الأمر بالعلم . ب ـ إخطار ولى الأمر رسميا من المدرسة بالدور الثانى للطالب . ج ـ أوراق خاصة برئيس الكنترول ( تشكيل لجنة الكنترول ـ إقرار موانع الامتحان ـ تعليمات سير الامتحانات ) . د ـ محضر فتح مظاريف أوراق الأسئلة . هـ ـ محضر فتح / غلق الكنترول . و ـ محضر تصحيح أوراق الاجابة . ز ـ كشف إجمالى بتوزيع اللجان من الصف الأول إلى الصف الخامس ( خاص بالكنترول ) =================================================================== وأخيـــــــــــــرًا فى حالة وجود أى قصور أو مقترحات واستفسارات عن البرنامج يرجى التواصل معنا عبر خطوط التواصل المختلفة سواء أرقام الهاتف المحمول أو البريد الإلكترونى أو الصفحة الرئيسية على موقع التواصل الاجتماعى الفيس بوك ـــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ مع تحياتى محمد إبراهيم الدسوقى معلم أول ( أ ) حاسب آلى محافظة الغربية ـ إدارة سمنود التعليمية مدرسة أم المؤمنين الابتدائية ـ بالراهبين 01125915740 // 01274757320 @@@@@@@@@@@@@@@@@@@@@@@ E.mail : me.100100@yahoo.com Facebook_Pro. : Mohamed Eldesoky @@@@@@@@@@@@@@@@@@@@@@@ والآن مع روابط التحميل : الصف الأول الابتدائى هنــا الصف الثانى الابتدائى هنــا الصف الثالث الابتدائى هنــا الصف الرابع الابتدائى هنــا الصف الخامس الابتدائى هنــا @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ السلام عليكم ورحمة الله

السلام عليكم ورحمة الله وبركاته بعد اذن أساتذة المنتدى ممكن عمل كود يعمل الاتى ترحيل المبالغ الموجوده في العمود D في شيت المبالغ الى شيت تجميع المبالغ كل على حسب الاسم وشهر السداد ولكن هنا يوجد أسماء مشتركة في الدور هنا يتم ترحيل المبلغ وتجميعه لهم وفى نفس الامر اسماء داخله باربع اسهم وثلاثة اسهم عند الترحيل تقسيمهم على الادوار مثال محمود عدد الاسهم واحد نصف يعنى هيدفع 150 جنيه ومحمود فى الاسماء مكرر مرتين مرة الاسم لواحدة والاسم الثانى مشترك مع الاسم محمد عدد الاسهم داخل بنصف سهم يعنى بيدفع 50 المطلوب عند الترحيل يجمع يرحل المبلغ 100 جنيه لمحمود ويرحل 50 جنيه لمحمود ويرحل 50 جنيه لمحمد ويجمعهم معا ليصبح المبلغ 100جنيه هذا نموج للحل الجمعية الشهرية.xlsm

السلام عليكم و رحمة الله و بركاته و مغفرته و رضوان لكم جميعا اخوتى الأعزاء أعضاء المنتدى و زواره كنت منذ عدة ايام طلبت كود ترحيل بسيط لكن لم ارفق ملف للتنفيذ و ها أنا ارفق الملف ولكن مع بعض التعديلات على الطلب الأول حيث مع محاولاتى لتعديل اكواد مشابهة ارتفع سقف طلبى ليتحول الكود المطلوب إلى اكواد استدعاء تعتمد على ٣ متغيرات حالة الطالب ناجح او دورثان نوع الطالب بنين او بنات حالة القيد ( منقول او مستجد او باق ) او منازل وفى كل متغير يوجد احتمالين كما هو موضح مع ملاحظة انى عاوز الكود يتعامل مع المنقول و المستجد و الباقي كأنهم متغير واحد اى اى كلمة منهم هم التلاتة تعامل نفس المعاملة الشيت مصدر البيانات و الشيتات الهدف اول سطر به بيانات هو السطر ٢١ و البيانات يمكن أن توجد حتى السطر رقم ٢٠٠٠ المفترض أن الكود هيقول بالتالي اول حاجة هيحذف الداتا فى ملفات الهدف فى الرانج من الخلية A21 : HZ2000 تانى حاجة هيستدعى الداتا المطلوبة من جميع الاعمدة من A:HZ فى شيت المصدر طبعا حسب المتغيرات فى الخلايا C1 D1 E1 بشيت الهدف و محدد اسماء و ارقام اعمدة تواجدها فى الشيت او المصدر تالت حاجة هيعمل مسلسل جديد للبيانات المستدعاة رابع حاجة هيعد عدد الطلبة اللى قام بجلب بياناتهم و هيكتب رسالة تم جلب بيانات عدد كذا طالب بنجاح انا عارف ان الكود بقى معقد شوية لكن كلى امل ان اساتذتى فى اوفيسنا ماتصعبش عليهم حاجة و تقبلوا اسمى و اخلص التحايا و الامانى ملف لتجربة كود الإستدعاء.xlsm

السلام عليكم كل الاحترام لهذا المنتدى والقائمبن عليه الافاضل واسمحوا لي بهذا الملف الذي اخذته من هذا الموقع العملاق واريد ان استفسر عن مايلي الملف مكون اربعة اوراق الاوراق الثلاثة - الورقة تحصيل من العملاء - الورقة الثانية مدفوعات للموردين - الورقة الثالثة مصاريف الشركة وهذه الاوراق ترحل الى الورقة الرابعة وهي الخزينة والمشكلة عندما تضيف مثلا تحصيل من احد العملاء على ورقة : تحصيل من العملاء وترحلها الى ورقة الخزينة للاسف هنا ترحل العملية + المسجل سابقا مما يضاف رصيد الخزينة ارجو من الاخوة الكرام تصحيح هذا الموضوع مع فائق الاحترام و التقدير لكم ترحيل من عدة شيتات الى شيت واحد1.xlsm

السلام عليكم برجاء من سيادتكم كودين ( موديولين ) الموديول1 خاص بـ شيت تسجيل الوارد وتم عمل كود ترحيل الى جميع الشيت حسب الاسم اما الموديول الثانى خاص بـ شيت تقرير المتابعة ( اننى اريد ترحيل صف معين من بعض الشيتات وذلك بشرط ان اظلل هذا الصف المراد ترحيلة الى شيت تقرير المتابعة ) ومرفق لسيادتكم نموذج المراد متابعة الاعمال الادارية.rar

السلام عليكم ورحمة الله وبركاته عندى شيت مرتبات بطبعه على 3 كشوف وكنت لما احب اعدل لازم اعدل فى كل شيت جمعت البيانات كلها فى شيت واحد وعاوز ارحل البيانات لكل شيت باسمه اعدادى 1 اعدادى 2 ثانوى ويتم اخفاء الأعمدة الفاضية من كل شيت علشان الطباعة تكون على ورقتين A3 وخالص شكرى مقدما لاعضاء المنتدى المحترمين ارجو الرد هل ينفع ولا مينفعش الترحيل لانى بحاول بيعمل معايا أخطاء ومش عارف السبب ابريل20222.xlsm

السادة اعضاء المنتدى الكرام برجاء مساعدتى فى الاتى :- المطلوب (1): ترحيل بيانات الاعمدة فى شيت تحصيلات من العملاء الى شيت الخزينة بحيث يرحل عمود المبلغ الى عمود المدين فى شيت الخزينة وعمود اسم العميل الى عمود البيان فى شيت الخزينة وهكذا المطلوب (2): ترحيل بيانات الاعمدة فى شيت مدفوعات الموردين الى شيت الخزينة بحيث يرحل عمود المبلغ الى عمود الدائن فى شيت الخزينة وعمود اسم المورد الى عمود البيان فى شيت الخزينة وهكذا المطلوب (3): ترحيل بيانات الاعمدة فى شيت مصاريف الشركة الى شيت الخزينة بحيث يرحل عمود المبلغ الى عمود الدائن فى شيت الخزينة وعمودالبيان الى عمود البيان فى شيت الخزينة وهكذا ومرفق ملف لتوضيح المطلوب ولسيادتكم جزيل الشكر ترحيل من عدة شيتات الى شيت واحد.rar

السلام عليكم ورحمة الله وبركاته كنت منذ زمن حملت ملف لدرجات الطلاب وقد أجريت عليه تعديلات يسيرة. أرجو المساعدة في إخراج هذا الملف بصورة جميلة وكلي ثقة بإبداعاتكم. المطلوب: تعديل الكود بحيث يرحل الناجحين إلى شيت: (ناجح) والذين عليهم الدور ثاني، إلى شيت: (دور ثاني) ولو في مجال ترحيل كذلك العشر الأوائل إلى الشيت المسمى بنفس الاسم وكذلك تعديل على شيت الإحصائية، وكذلك ترحيل الغائبين عن الاختبار إلى شيت الغائبين. كشوفات الناجحين والراسبين - فصل واحد.xlsm

بسم الله الرحمن الرحيم الاخوة الزملاء فى هذا الصرح العظيم اقدم لكم الدرس الثانى من علمنى كيف اصطاد شرح مبسط عن كيفية عمل كود ترحيل من خلايا متفرقه بورقه عمل الى ورقة عمل اخرى بناء على طلب الاخ الكريم / بيف الدين حسام يريد معرفه كيفية عمل كود ترحيل من سند قبض الى شيت الخزينة كما هو موضح بالصور المطلوب ترحيل الخلايا المظلله باللون الاصفر بورقه عمل (توريد) الى ورقة عمل حركة الخزينة اولا : الضغط على ALT+F11 لفتح محرر الاكواد ثم من قائمة insert نختار مودويل جديد سيظهر لنا شاشة بيضه هنبداء بسم الله كتابة الكود Sub ترحيل() End Sub السطر الاول هو الاعلان عن بداية الكود sub يلية اسم الكود وهو ترحيل يلية () يعنى فتح قوس ثم غلقه فبمجرد كتابة السطر الاول سوف يتم ظهور السطر الثانى وهو End sub أنا عايز كل واحد يكتب الكود بنفسة مش ينسخ / من فضلك عايزك تكتب ثانيا : كتابة هذا السطر Sub ترحيل() Application.ScreenUpdating = False End Sub هذا السطر يعنى تثبيت الشاشه عند الترحيل ( يعنى عدم اهتزاز الشاشه اثناء تطبيق الكود ) ثالثا : ايه المطلوب هو ترحيل الخلايا المظلله باللون الاصفر بورقه عمل توريد الى ورقة عمل حركة الخزينة اذن الشيت اللى هتروح له البيانات هو شيت حركة الخزينة وهو اسمه حسب الملف المرفق وكما هو موضح بالصورة Sheet4 وليس حركة الخزينة ملحوظه/عند استخدم اسم شيت باى كود يفضل كتابة اسم الشيت الثابت كما هو بمحرر الاكواد لانه احتمال تغيير اسم الشيت من (حركة الخزينة) الى (قاعدة البيانات )مثلا فى هذه الحاله لا يعمل الكود نرجع للكود بتاعنا ونضيف الاتى Sub ترحيل() Application.ScreenUpdating = False With Sheet4 End With End Sub ما تم اضافته هو With Sheet4 كلمة With معناها الحرفى ( مع) أى مع الشيت Sheet4 لماذا استخدمنا Sheet4 وليس ( حركة الخزينة) لان لو كتبنا (حركة الخزينة With) وجيت حضرتك وغيرت اسم الشيت من حركة خزينة الى قاعدة البيانات مثلا لا يتغير اسم الشيت فى محرر الاكواد فهو هيظل ثابت باسم Sheet4 وفى هذه الحاله لا يعمل الكود لانه هيبجث عن شيت حركة الخزينة هيكون غير موجود لكن لو استخدمت With Sheet4 مهما تغير اسم الشيت هيشتغل الكود طيب اى شئ بفتحه فى الاكسيل لازم اقفله انا دلوقتى فتحت With Sheet4 اذن لا بد من قفل With بـــ End With رابعا : اضافه السطر التالى Sub ترحيل() Application.ScreenUpdating = False With Sheet4 Lr = .Cells(.Rows.Count, "D").End(xlUp).Row End With End Sub الجديد هو هذا السطر Lr = .Cells(.Rows.Count, "D").End(xlUp).Row عملنا متغير اسمه LR ويمكنك تغيير الى ما تريد من الاحرف حسب مزاجك حضرتك طيب وعرفناه انه عبارة عن اخر خليه بها بيانات فى عمود D من شيت حركة الخزينة وهى هنا كما هو بالصورة عليه الخلية D4 مكتوب فيها " رصيد افتتاحى" واحد هيقولى مش فاهم هوضح له اكتر مثلا عايز اقول ان " الاستاذ الكبير العلامه ياسر خليل العبقرى" = r فبدل كل شوية ما اكتب الجمله دى " الاستاذ الكبير العلامه ياسر خليل العبقرى " وتاخد منى وقت استعيض عنها بى r فقط / على طول الكود هيفهم معناها خامسا : اضافه السطر التالى Sub ترحيل() Application.ScreenUpdating = False With Sheet4 Lr = .Cells(.Rows.Count, "D").End(xlUp).Row .Cells(Lr + 1, "A") = [D8] End With End Sub ما هو الجديد الجديد هذا السطر [Cells(Lr + 1, "A") = [D8. ماذا يعنى الجزء الاول و هو.("Cells(Lr + 1, "A. (العمود, الصف)Cells. الصف هو Lr+1 يعنى Lr هى اخر صف فى العمود D من شيت حركة الخزينة فيه بيانات ( طيب انا عايز بقى السطر اللى بعده يبقى اقول Lr+1 طيب والعمود هو A وتم كتابته بين علمتى تنصيص "A" ( شيفت + حرف الطاء بالكيبور) طيب عمود A ده عايزين يروح له التاريخ اللى بسند القبض / والتاريخ اللى بسند القبض موجود بالخلية D8 صح اذن اقول [Cells(Lr + 1, "A") = [D8. وهكذا كما هو موضح بالكود يتم ترحيل كامل بيانات السند ثم نغلق With ب End With Sub ترحيل() Application.ScreenUpdating = False With Sheet4 Lr = .Cells(.Rows.Count, "D").End(xlUp).Row .Cells(Lr + 1, "A") = [D8] .Cells(Lr + 1, "B") = [G7] .Cells(Lr + 1, "D") = [D10] .Cells(Lr + 1, "G") = [d11] .Cells(Lr + 1, "E") = "=R[-1]C+RC[2]-RC[1]" End With End Sub اضغط على زر الترحيل ستجد البيانات تم ترحيلها ارجوا من الله ان اكون وفقت فى هذا الشرح ويستفيد منه الجميع ان احسنت فمن الله وما توفيقى الا بالله وان اخطأت فمن نفسى والشيطان وارجوا من الاساتذه الافاضل مراجعه الشرح وتصحيح ما به من أخطأ ولى رجاء من ادارة المنتدى جعل التعديل على الشرح متاح لى حتى يتثنى لى اضافه بعض الاشياء الاخرى تخص نفس الموضوع انا استكفيت بهذا القدر حتى يكون سهل على الاعضاء اللى عايز يطبق وان شاء الله سوف نكمل ما بدأناه تقبلوا منى وافر الاحترام والتقدير خزينة.zip

السلام عليكم ممكن اخواني ترحيل بيانات الشيتات في شيت واحد - وكما مبين في الملف المرفق ، وفكرة الترحيل واسلوبها يمكم جزيتم خيرا ترحيل.rar

السلام عليكم ارجو المساعدة في ترحيل متعدد و اختيار الصفوف من صف واحد و لغاية 24 من خلال شيت data من الخلايا b4, b5,b6...........b27 ثم الضغط على زر ترحيل الى شيت book حسب الترقيم اسفل الجدول الكود التالي كنب بمساعدة الاخ @hassona229 , و له جزيل الشكر و يقوم بترحيل صف واحد Sub Test() Const nRows As Long = 25 Const sCells As String = "b39,b103,b167,b231,b295,b359,b423,b487,b551,b615,b679,b6,b71,b135,b199,b263,b327,b391,b455,b519,b583,b647" Dim x, a, t, ws As Worksheet, sh As Worksheet, wsdata As Worksheet, rng As Range, r As Range, lr As Long, n As Long, i As Long, m As Long, ii As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("Name") Set sh = ThisWorkbook.Worksheets("book") Set wsdata = ThisWorkbook.Worksheets("data") sh.Range("a6:b30,a39:b63,a71:b95,a103:b127,a135:b159,a167:b191,a199:b223,a231:b255,a263:b287,a295:b319,a327:b351,a359:b383,a391:b415,a423:b447,a455:b479,a487:b511,a519:b543,a551:b575,a583:b607,a615:b639,a647:b671,a679:b703").ClearContents x = Application.Match(wsdata.Range("b4").Value, ws.Rows(2), 0) If Not IsError(x) Then lr = ws.Cells(Rows.Count, x).End(xlUp).Row If lr < 4 Then MsgBox "No Data", vbExclamation: Exit Sub Set rng = ws.Range(ws.Cells(5, x - 1), ws.Cells(lr, x)) a = rng.Value n = UBound(Split(sCells, ",")) + 1 For i = 1 To n Set r = sh.Range(Split(sCells, ",")(i - 1)) t = Application.Index(a, Evaluate("(Row(" & m + 1 & ":" & m + nRows - 1 + 1 & "))"), Array(1, 2)) m = m + nRows For ii = UBound(t) To LBound(t) Step -1 If IsError(t(ii, 1)) Then t(ii, 1) = Empty t(ii, 2) = Empty Else Exit For End If Next ii r.Offset(0, -1).Resize(UBound(t), 2).Value = t Set r = Nothing Next i End If Application.ScreenUpdating = True End Sub الملف في المرفق كتيب العلامات 2022.xlsm

السلام عليكم ورحمة الله ..يوجد في هذا الكود مشكله لا اعرفها فعند ترحيل البيانات لعميل واحد فقط يقوم بالمطلوب وعدنما اقوم بفتح شيت اخر لعميل اخر لا يعمل لا اعلم اين المشكلة برجاء من سيادتكم تطبيق الكود على الملف المرفق وجزاكم الله كل خير ..sheet1 يكون فيه البيانات المراد اخذ نسخه منها وترحيلها للشيت المكتوب في الخلية C3 وهو رقم هاتف العميل Mahmoud.xlsm

السلام عليكم عندي ملف اكسيل وفي صفحه عامه ( شهريه ) بيتم تسجيل فيها اي حركه ولكل عميل يوجد شيت منفرد لحسابه الشخصي والمدفوعات عايز معادله او حل ان لما ادخل البيانات في الصفحه الرئيسيه باسم العميل يتم اضافه السطر كاملا بنفس البيانات في صفحه العميل تلقائيا على اساس لما احتاج اعمل كشف حساب للعميل يكون جاهز وفيه كل حركات حسابه ؟ هل يوجد برنامج جاهز للموضوع دا ؟... الملف متاح بس المفروض ان الشرح بتاعي مستوف المطلوب او انا مش عارف اوصل المعلومه .. الملف في المرفقات ... يوجد شيت لكل شهر، وفي كل شهر عدد من التعاملات عايز اعمل كشف حساب للعملاء كل واحد لوحده ( اعمل لكل عميل شيت حساب لوحده) عايز لما اضيف عمليه جديده باسم عميل تتنقل تلقائي لصفحه الحساب بتاعته عشان لما اجي اراجع حساب عميل يبقى مكتوب فيه اسم العمليات كمان والحساب يوميه المكتب .xlsm

السلام عليكم برجاء المساعدة في كيفية عمل كود ترحيل من الشيتين المرفقين الى شيت واحد لعمل ميزان مجمع يجمع الشيتين معا تحت بعض ميزان.rar

السلام عليكم اخ @hassona229 نعم لكن للاكسل بعد تصدير الاسماء من شيت name الى book حسب الاختيار من شيت data اخ @hassona229 فكرة ملف العمل هو عملية ترحيل الاسماء الى ورقة book ثم يقوم بطباعتها على شكل كتاب الطباعة تكون بعد تسخ الاسماء للطلبة ملاحظة ليس نسخ جميع الاسماء للصفوف التسخ يكون شرط اختيار الصفوف من صفحة data الاختيار ممكن يكون صف واحد او خمسة او عشرة او اعلى اختيار 24 صف اتمنى ان يكون الشرح واضح و جزاك الله خير الجزاء السلام عليكم هل هنالك من طريقة لعمل الماكرو او اي فكرة لترحيل الاسماء،؟ و شكرا للجميع

الاساتذة الافاضل الاخوة بحاجة لفكرة من خبراتكم لتسهل عليا الموضوع الموضوع ان لدى عدد 6 مصنفات كل حياتى بالملفات هذه الملفات ال6 بها نفس الاكواد ونفس التقارير اغلبها من اهداء الاستاذ العبقرى سليم حصبيا الشيتات بكل مصنف هى اسماء حسابات فى 6 مصنفات عدد114 شيت وهى 114 حساب الاعمدة فى ال6 مصفات هى 20 شخص كل مصنف به فى كل شيت عدد 5 اشخاص يوجد حسابات مشتركة فى ال 6 مصنفات عدد 20 حساب مشترك انا اعمل على ال6 مصنفات بحيث ادخل كل شخص سدد مبلغ كام على الحساب من خلال شيت ترحيل واذا طلب اى تقرير اقوم بجمع ال6 تقارير واجمعهم فى تقرير واحد حيث يوجد تقرير به اسماء الحسابات بتاريخ احتاج افكارسهلة انفذها بحيث اجمع ال 114 شيت فى مصنف واحد فى كل شيت 20 عمود بحيث اطلع تقرير مجمع جاهز للطباعة مرفق ملف من 6 ملفات به التقرير الذى اهداه الى اخى فى الله استاذ سليم اعزه الله , m هى اسم الشخص و1و2و3 اسم الحساب شكر وتقدير واحترام My_Repport_Updated.xlsm

السلام عليكم إخواني أهل المنتدى أريد معادلة ترحيل البيانات من شيت واحد إلى شيت 2 كما هو موضح في الجدول تـــم تعديل عنوان المشاركة ليتناسب مع طلبك صالح.xlsx

الاساتذة الاخوة الخبراء احبائى الاعزاء نظرا لاننى اقوم بتصميم شيت الاكسيل المبرمج الخاص بى فطلباتى زائدة اليومين دول سامحونى رأيت موضوع للعلامة عبدالله بقشير (خبور الخير) اسمه ترحيل الى ماشئت من صفحات احتاج لتطبيقه لدى ملف به عدد من الاعمدة التاريخ والبيان والمبلغ واسم الشيت يختار من ليست و اسم العمود يختار من ليست ولدى مفتاحين واحد ترحيل وواحد استدعاء احتاج كود الترحيل والاستدعاء مع خالص الشكر والاحترام والتقدير اخواتى الافاضل الخبراء ترحيل واستدعاء.xlsx

وعليكم السلام اخى @محمد عدنان طلبك من البدايه كان ترحيل صف واحد وهو في الخليه b4 من شيت data وهذا ما تم عمله اختر افضل اجابه لسؤالك وافتح موضوع جديد بالطلب الجديد وان شاء الله تجد مطلبك سواء منى او من الاساتذه

الاخوه الزملاء رجاء المساعدة فى شيت تسويات20كان عليه يوزرفوم ولم اردت احميه برقم الماذربورد اختفى اليوزفورم فانى اريد استرجاعه وتفعيل كود حمايه الماذر بورد لانى اريد العمل به على جهاز واحد فقط 2-اريد فى الملف المرفق ايضا عندما اضغط على خانه ترحيل باب اول وانا فاتح شيت باب اول تنقل البيانات من تسويات 20 الى شيت باب اول بنفس الترتيب ونفس الوضع بالنسبه لشيت باب ثانى عندما افتح شيت باب ثانى تنقل البيانات لشيت باب ثانى بنفس الترتيب ارجو المساعده لانى محتاج اليه فى العمل شيت محمى.rar