seaf mohamed قام بنشر سبتمبر 7, 2022 مشاركة قام بنشر سبتمبر 7, 2022 برجاء التكرم بشرح الكود الموجود بالشيت لانى محتاج اعدل علية اضيف اعمدة فى كل شيت فمحتاج افهمة علشان اعدل صح ويتنفذ صح ..وشكرا انتبه من فضلك ...مشاركة مكررة فقد تــــم بالفعل حذف المشاركة الأخرى New-Microsoft-Excel-Worksheet-2 (1).xlsm رابط هذا التعليق شارك More sharing options...
أفضل إجابة ابراهيم الحداد قام بنشر سبتمبر 8, 2022 أفضل إجابة مشاركة قام بنشر سبتمبر 8, 2022 السلام عليكم و رحمة الله اتمنى ان يكون هذا ما تصبو اليه Sub try01() Dim r, r2, x, l As Long Dim ws As Worksheet ' [هذه العبارة تم اضافتها حتى يعمل معك الكود من اى ورقة Set ws = Sheets("summare ") ' اسم الورقة التى سوف يتم العمل عليها ws.Range("b7:o1000") = "" ' محو البيانات القديمة x = ThisWorkbook.Sheets.Count ' عدد الشيتات فى الملف r = 7 ' الصف الذى سوف يبدأالعمل من خلاله For i = 3 To x ' ترتيب الشيتات التى سوف يتم استيراد البيانات منها 'اسم الشيت ws.Cells(r, "b") = Sheets(i).Name ' اسماء الشيتات تسجل فى هذا العمود ws.Cells(r, "c") = Sheets(i).Range("c8") ' رقم العقد و الموجود فى هذه الخلية من الشيتات المشار اليها ' عدد الصفوف بالشيت Z = Sheets(i).Cells(Rows.Count, "b").End(xlUp).Row ' آخر صف فى هذا العمود For i2 = 12 To Z ' البداية من الصف 12 حتى الصف 'التاريخ dt = Sheets(i).Cells(i2, "b") ' الاعمدة التى تحتوى على التواريخ التى سيتم جلب البيانات منها For i3 = 4 To 15 ' الاعمدة التى سوف يتم جلب البيانات اليها If Month(ws.Cells(6, i3)) = Month(dt) And Year(ws.Cells(6, i3)) = Year(dt) Then ' شرط استدعاء البيانات ws.Cells(r, i3) = Sheets(i).Cells(i2, "f") + ws.Cells(r, i3) ' الامر بأضافة البيانات End If Next i3 Next i2 r = r + 1 Next i End Sub 2 1 رابط هذا التعليق شارك More sharing options...
seaf mohamed قام بنشر سبتمبر 8, 2022 الكاتب مشاركة قام بنشر سبتمبر 8, 2022 تمام هو دة المطلوب والف الف شكر 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها