مداد_1423 قام بنشر يناير 14, 2020 مشاركة قام بنشر يناير 14, 2020 تحية طيبة وبعد:- أتمنى يكون الجميع بصحة وسلامة لدي ملف في كود من إبداع أستاذنا سليم حاصبيا المطلوب إضافة شيت جديد بحيث يكون ترتيب التجميع في شيت ALL أولا: Shift Schedule ثانيا: Overtime ثالثا: Attendance ويكون التجميع بيانات من غير تنسيق إذا أمكن مع الشكر لكل من مر هنا وأخص بالشكر والدعاء من ساعدني تحياتي Option Explicit Sub copy_data() Dim S As Worksheet: Set S = Sheets("ALL") Dim O As Worksheet: Set O = Sheets("Overtime") Dim A As Worksheet: Set A = Sheets("Attendance") Dim Final_S: Final_S = S.Cells(Rows.Count, 1).End(3).Row Dim Final_O: Final_O = O.Cells(Rows.Count, 1).End(3).Row Dim Final_A: Final_A = A.Cells(Rows.Count, 1).End(3).Row Dim Rs As Range: Set Rs = S.Range("A8:AG" & Final_S) Dim RO As Range: Set RO = O.Range("A8:AG" & Final_O) Dim RA As Range: Set RA = A.Range("A8:AG" & Final_A) Dim i%, xO%, XA%, xx% xO = RO.Rows.Count: XA = RA.Rows.Count Rs.ClearContents i = 1: xx = 8 Do Until i > xO S.Cells(xx, 1) = RO.Cells(i, 1) S.Cells(xx, 3).Resize(, RO.Columns.Count - 2).Value = _ RO.Cells(i, 3).Resize(, RO.Columns.Count - 2).Value i = i + 1: xx = xx + 2 Loop i = 1: xx = 9 Do Until i > XA S.Cells(xx, 1) = RA.Cells(i, 1) S.Cells(xx, 3).Resize(, RA.Columns.Count - 2).Value = _ RA.Cells(i, 3).Resize(, RA.Columns.Count - 2).Value i = i + 1: xx = xx + 2 Loop End Sub HR_TEST1.xlsm رابط هذا التعليق شارك More sharing options...
أفضل إجابة مداد_1423 قام بنشر يناير 18, 2020 الكاتب أفضل إجابة مشاركة قام بنشر يناير 18, 2020 تم الحل بعد محاولات وتجارب لكن حصل المقصود لكم الشكر يا سادة Sub copy_data() Dim S As Worksheet: Set S = Sheets("ALL") Dim Q As Worksheet: Set Q = Sheets("Shift Schedule") Dim O As Worksheet: Set O = Sheets("Overtime") Dim A As Worksheet: Set A = Sheets("Attendance") Dim Final_Q: Final_Q = Q.Cells(Rows.Count, 1).End(3).Row Dim Final_S: Final_S = S.Cells(Rows.Count, 1).End(3).Row Dim Final_O: Final_O = O.Cells(Rows.Count, 1).End(3).Row Dim Final_A: Final_A = A.Cells(Rows.Count, 1).End(3).Row Dim RQ As Range: Set RQ = Q.Range("A8:AG" & Final_Q) Dim Rs As Range: Set Rs = S.Range("A8:AG" & Final_S) Dim RO As Range: Set RO = O.Range("A8:AG" & Final_O) Dim RA As Range: Set RA = A.Range("A8:AG" & Final_A) Dim i%, XQ, xO%, XA%, xx% XQ = RQ.Rows.Count: xO = RO.Rows.Count: XA = RA.Rows.Count Rs.ClearContents i = 1: xx = 8 Do Until i > XQ S.Cells(xx, 1) = RQ.Cells(i, 1) S.Cells(xx, 3).Resize(, RQ.Columns.Count - 2).Value = _ RQ.Cells(i, 3).Resize(, RQ.Columns.Count - 2).Value i = i + 1: xx = xx + 3 Loop i = 1: xx = 9 Do Until i > xO S.Cells(xx, 1) = RO.Cells(i, 1) S.Cells(xx, 3).Resize(, RO.Columns.Count - 2).Value = _ RO.Cells(i, 3).Resize(, RO.Columns.Count - 2).Value i = i + 1: xx = xx + 3 Loop i = 1: xx = 10 Do Until i > XA S.Cells(xx, 1) = RA.Cells(i, 1) S.Cells(xx, 3).Resize(, RA.Columns.Count - 2).Value = _ RA.Cells(i, 3).Resize(, RA.Columns.Count - 2).Value i = i + 1: xx = xx + 3 Loop End Sub 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.