2saad قام بنشر يونيو 27, 2023 مشاركة قام بنشر يونيو 27, 2023 السلام عليكم ورحمة الله و بركاته لو سمحت انا عايز يتم الترحيل من الشيت 1 و2 و3 في الأعمدة الملونة فقط الي شيت ( eman ) من العمود c10) أنا حاولت بس معرفتش ولكم جزيل الشكر وكل عام وانتم بخيركل عام وانت بخير.xlsm رابط هذا التعليق شارك More sharing options...
خالد المصـــــــــــرى قام بنشر يونيو 28, 2023 مشاركة قام بنشر يونيو 28, 2023 بالمعادلات كل عام وانت بخير(1).xlsm بالمعادلات 3 رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يونيو 28, 2023 مشاركة قام بنشر يونيو 28, 2023 وعليكم السلام ورحمة الله تعالى وبركاته Sub Sheets_Arr() Dim a, b, C As Variant, lr& Dim Dest As Worksheet: Set Dest = Sheets("eman") 'Columns : E,F,H,L,M,P,Q Const r As String = "5 6 8 10 12 13 16 17 " For Each C In Sheets(Array("Sheet1", "Sheet2", "Sheet3")) lastrow = Dest.Cells(Dest.Rows.Count, "C").End(xlUp).Row + 1 Application.ScreenUpdating = False lr = C.Columns("A:Q").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row a = Evaluate("row(10:" & lr + 10 & ")") b = Split(r) Dest.Range("c" & lastrow).Resize(lr, UBound(b)).Value = Application.Index(C.Cells, a, b) Application.ScreenUpdating = True Next C End Sub عيد مبارك سعيد.xlsm 3 رابط هذا التعليق شارك More sharing options...
أبوأحـمـد قام بنشر يونيو 28, 2023 مشاركة قام بنشر يونيو 28, 2023 وعليكم السلام ورحمة الله وبركاته أتمنى أن يفيد هذا Sub TR7el() Dim ro, ro4 As Long ro = Worksheets(1).Range("C" & Rows.Count).End(xlUp).Row Worksheets(1).Range("D10:E" & ro & ",J10:J" & ro & ",I10:I" & ro & ",K10:L" & ro & ",O10:P" & ro).Copy _ Worksheets(4).Range("c10") ro = Worksheets(2).Range("C" & Rows.Count).End(xlUp).Row ro4 = Worksheets(4).Range("C" & Rows.Count).End(xlUp).Row + 1 Worksheets(2).Range("D10:E" & ro & ",J10:J" & ro & ",I10:I" & ro & ",K10:L" & ro & ",O10:P" & ro).Copy _ Worksheets(4).Range("c" & ro4) ro4 = Worksheets(4).Range("C" & Rows.Count).End(xlUp).Row + 1 ro = Worksheets(3).Range("C" & Rows.Count).End(xlUp).Row Worksheets(3).Range("D10:E" & ro & ",J10:J" & ro & ",I10:I" & ro & ",K10:L" & ro & ",O10:P" & ro).Copy _ Worksheets(4).Range("c" & ro4) End Sub كل عام وانت بخير.xlsm 3 رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد هشام. قام بنشر يونيو 28, 2023 أفضل إجابة مشاركة قام بنشر يونيو 28, 2023 (معدل) حل اخر في حالة الرغبة بمسح البيانات القديمة وترحيل الجديدة Sub Sheets_Arrays2() ' بالتنسيقات Dim LR&, LR2&, lrow& Dim wsData As Variant Dim Dest As Worksheet: Set Dest = Sheets("eman") lRow = Dest.Cells(Dest.Rows.Count, "C").End(xlUp).Offset(1).Row Application.ScreenUpdating = False Dest.Range("C10:J" & lRow).ClearContents For Each wsData In Sheets(Array("Sheet1", "Sheet2", "Sheet3")) a = wsData.Cells(Rows.Count, "E").End(xlUp).Row b = Dest.Cells(Rows.Count, "C").End(xlUp).Row wsData.Range("E10:F" & a).Copy Dest.Range("C" & b + 1) wsData.Range("H10:H" & a).Copy Dest.Range("E" & b + 1) wsData.Range("J10:J" & a).Copy Dest.Range("F" & b + 1) wsData.Range("L10:M" & a).Copy Dest.Range("G" & b + 1) wsData.Range("P10:Q" & a).Copy Dest.Range("I" & b + 1) Application.ScreenUpdating = True Next wsData End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' قيم Sub Sheets_Arrays3() Dim LR&, LR2& Dim wsData As Variant Dim Dest As Worksheet: Set Dest = Sheets("eman") lrow = Dest.Cells(Dest.Rows.Count, "C").End(xlUp).Offset(1).Row Application.ScreenUpdating = False Dest.Range("C10:J" & lrow).ClearContents For Each wsData In Sheets(Array("sheet1", "sheet2", "sheet3")) LR = wsData.Cells(Rows.Count, "E").End(xlUp).Row LR2 = Dest.Cells(Rows.Count, "C").End(xlUp).Row + 1 With wsData Dest.Range("C" & LR2 & ":d" & LR2 + LR - 10).Value = wsData.Range("E10:F" & LR).Value Dest.Range("E" & LR2 & ":e" & LR2 + LR - 10).Value = wsData.Range("H10:H" & LR).Value Dest.Range("F" & LR2 & ":F" & LR2 + LR - 10).Value = wsData.Range("J10:J" & LR).Value Dest.Range("G" & LR2 & ":h" & LR2 + LR - 10).Value = wsData.Range("L10:M" & LR).Value Dest.Range("I" & LR2 & ":j" & LR2 + LR - 10).Value = wsData.Range("P10:Q" & LR).Value End With Application.ScreenUpdating = True Next wsData End Sub عيد مبارك سعيد2.xlsm تم تعديل يونيو 28, 2023 بواسطه Mohamed Hicham 3 رابط هذا التعليق شارك More sharing options...
2saad قام بنشر يونيو 28, 2023 الكاتب مشاركة قام بنشر يونيو 28, 2023 شكرا لكم جميعا وجعله الله في ميزان حسناتكم جميعا وعيد سعيد علينا وعليكم وكل عام وانتم بخير وسعادة وزادكم الله من علمه رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان