إبراهيم ابوليله

الاخوه الاكرام ارجو المساعده تم تعديل الملف دفتر حركة - Copy.rar

الاخوه الكرام طبعا من بدأ عرض فكره استخدام TAG هو الاخ الجموعى بارك الله فيه ولكن اسمحو لى بعرض مثال يبسط الفكره اكثر وهذا من وجهه نظرى تقبلو تحياتى Private Sub CommandButton1_Click() Dim Ctl As Control Dim Ctl1 As Control Dim i As Integer Dim i1 As Integer For Each Ctl In UserForm1.Controls If Not Ctl.Tag = "" Then For i1 = 1 To 1 ' åäÇ íÊã ÇÚØÇÁ Çááæä ÇáÇÍãÑ áÇì ßäÊÑæá ÞíãÉ ÇáÊÇÌ ÝíåÇ ÊÓÇæì ÇáÑÞã 1 If Ctl.Tag = i1 Then Ctl.BackColor = vbRed End If Next For i = 2 To 4 ' åäÇ íÊã ÇÚØÇÁ Çááæä ÇáÇÕÝÑ áÇì ßäÊÑæá ÞíãÉ ÇáÊÇÌ ÝíåÇ ÊäÍÕÑ Èíä ÇáÑÞã 2 æÇáÑÞã 4 If Ctl.Tag = i Then Ctl.BackColor = vbYellow End If Next End If Next End Sub TAG.rar

اخى الفاضل أ.إبراهيم لا يشترط حرف ال L نهائي .. ممكن تغييره الى اى حرف آخر تريده .. احنا واضعين حرف ال L اختصار لكلمة Label فقط لكن ليس شرطا تحياتي اخى ابن مصر اشكرك على التوضيح تقبل تحياتى

اخى الجموعى فكره رائعه وكود جميل تقبل تحياتى --------------------------- اخى ابن مصر اكواد جميله وافكار رائعه ولكن لماذا حرف L بالاخص ممكن التوضيح تقبل تحياتى

اخى الجموعى كود اجمل وبالفعل اقصر من الكود السابق اشكرك على الاهتمام تقبل تحياتى

اخى الجموعى اشكرك على الرد طبعا الكود يؤدى الغرض تماما ولكن فى انتظار ردود اخرى لعلها تكون اقصر تقبل تحياتى

الاخوه الكرام هل يمكن تشفر INPUTBOX بمعن انه عند الكتابه فيها تظهر الكتابه ************ تقبلو تحياتى

اخى تفضل ما تريده تقبل تحياتى Book2.rar

نسأل الله ان يكونو بخير وفى اتم وافضل حال تقبلو تحياتى

للرفع

اخى اشكرك على المتابعه وعلى الكلمات الجميله واوجه اليك الدعوه الى متابعة الشرح على الرابط الاتى http://www.officena.net/ib/index.php?showtopic=57179 تقبل تحياتى

اخى ياسر اشكرك على الاهتمام ولكنى اريد ان يكون الناتج هو من القيم الموجوده فى العمودr تقبل تحياتى

االخوه الافاضل لماذا يحدث خطأ فى المعادله الموجوده فى العمود s ---------- اكتشفت ان الخطأ يحدث بسبب اعتماد المعادله على جلب بيانات من خلايا بها معادلات والله اعلم ------------------------------- جرب تغير مسار المعادله فى جلب البيانات بان تجعلها بدلا من العمود R الى العمود t ستجد ان المعادله تعمل بصوره صحيحه ------------------------------------- ارجو المساعده فى تصحيح الخطأ Book1.rar

اخى ياسر اخى اريدها بالفعل كما هى اشكرك على الاهتمام تقبل تحياتى

الاخوه الافاضل ارجو المساعده فى تحويل المعادله الموجوده فى العمود N الى كود وذلك بمجرد الكتابه فى العمود i دفتر حركة1.rar

اخى الريفى مشكورا على المجهود الكبير ومعادلات رائعه تقبل تحياتى

اخى قم بزياره الموقع التالى حيث يتم شرح كيفيه عمل البرنامج http://www.officena.net/ib/index.php?showtopic=57179&hl= تقبل تحياتى

اخى الريفى يعيب هذه المعادله انه فى حالة تكرار البيانات لا تكون النتائج صحيحه لانه والله اعلم انها ليست من دوال البحث وانما من الدوال الحسابيه لذلك فى حالة التكرار يتم اجراء عمليه حسابيه على نتائج البحث تقبل تحياتى

اخى اشكرك على المتابعه المستمره للموضوع واتمنى ان اكون قد وفقت فى شرح الدرس السابق تقبل تحياتى

اخى الريفى معادله جيده واسمح لى بالمشاركه =INDEX('main data'!A1:H57,MATCH(1,('main data'!A1:A57=A2)*('main data'!B1:B57=D2)*('main data'!C1:C57=C2),0),4) هذه معادلة صفيف =LOOKUP(2,1/('main data'!A2:A57=calculator!A2)/('main data'!B2:B57=calculator!D2)/('main data'!C2:C57=calculator!C2),('main data'!D2:D57)) تقبل تحياتى

اخى الريفى موضوع جميل ومعادلات اجمل فى انتظار المزيد تقبل تحياتى

بسم الله الرحمن الرحيم والصلاة والسلام على اشرف المرسلين سيدنا محمد صلى الله عليه وسلم لقد قدمت سابقا نموذج فاتوره على الاكسيل بدون فورم وبناء على طلب بعض الاخوه فى شرح كيفيه عمل النموذج وتلبية لرغباتهم نتناول طريقه عمل النموذج ونظرا لضيق الوقت ان شاء الله يتم تناول درس يوميا على الاقل حتى الانتهاء بإذن الله .......................................................................... الاخوه الافاضل الحمد لله فقد انتهينا من شرح الدرس الاول وهو عباره عن ثلاثة دروس تمهيديه وهى اولا--تصميم الفاتوره ثانيا--انشاء شيت به الاكواد المساعده ثالثا--انشاء شيت لتجميع بيانات الفواتير المسجله --------------------------------------------------- الان نبدأ فى شرح الدرس الثانى وقد انتهينا سابقان من تناول الدرس الثانى ( أ ) الكود الاول--كود يقوم بعمل تسلسل لرقم الفاتوره الدرس الثانى ( ب ) الكود الثانى--كود يقوم بعمل تسلسل لبيانات الفاتوره الدرس الثانى ( ج ) كود الثالث--يقوم باحضار بيانات العميل عند كتابة الكود الخاص بالعميل الدرس الثانى ( ح ) الكود الرابع---كود يقوم باحضار بيانات الصنف عند كتابة الكود الخاص بالصنف تابع الدرس الثانى ( ح )كود يقوم باستخراج القيمه الخاصه بكل صنف ثم استخراج اجمالى قيمة الفاتوره الان نتناول شرح الدرس الثانى ( خ ) الكود الخامس---كود يقوم بترحيل بيانات الفاتوره الى شيت 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

اخى ابن مصر محاوله رائعه واكواد جميله بارك الله فيك تقبل تحياتى

اخى kmb اشكرك على المتابعه المستمره للموضوع واتمنى ان يكون مستفادا منه غدا ان شاء الله يتم استكمال الشرح تقبل تحياتى

اخى ان شاء الله غدا ييتم شرح كود الترحيل تقبل تحياتى