ترحيل أوراق عمل محددة الي ورقة واحدة

[2saad]

إخواني أعضاء المنتدي الكرام بعد سلام الله عليكم ورحمنته وبركاته

الكود المرفق هو عبارة عن ترحيل كل الأوراق الي ورقة واحدة وأنا محتاج ارحل أوراق معينة يعني ( 1و2 3 ) فقط الي ورقة العمل ( total )

ولكم جزيل الشكرترحيل من عدة صفحات إلى صفحة واحدة.xlsm

[2saad]

السلام عليكم ورحمة الله بركاته

لو سمحت يا استاذ محمد

انا عايز يتم الترحيل من الشيت 1 و2 و3 ( من العمود 5K الي 5M ) الي شيت ( TOTAL ) من العمود C5 الي العمود F5 )

أنا حاولت بس معرفتش

[محمد هشام.]

Sub Sheets_Arrays1()
Dim temp        As Variant
Dim arr         As Variant
Dim F           As Boolean
Dim ws          As Variant
Dim WSdata    As Worksheet: Set WSdata = Sheets("Total")

For Each ws In Sheets(Array("1", "2", "3"))
            temp = ws.Range("k5:N" & ws.Cells(Rows.Count, 11).End(xlUp).Row).Value
            If F Then
                arr = ArrayJoin(arr, temp)
            Else
                arr = temp
                F = True
            End If
        
    Next ws
    With Sheets("Total")
        .Range("C4").Resize(1, 4).Value = Array("م", "الاسم", "الرقم الوظيفي", "سعد")
        .Range("C5").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    End With
End Sub
'''''''''''''''''''ترحيل البيانات    في اخر صف فارغ'''''''''''''''''''''''
Sub Sheets_Arrays2()
Dim F&, j&
Dim ws        As Variant
Dim WSdata    As Worksheet: Set WSdata = Sheets("Total")
WSdata.Range("C4").Resize(1, 4).Value = Array("م", "الاسم", "الرقم الوظيفي", "سعد")

For Each ws In Sheets(Array("1", "2", "3"))

F = ws.Cells(Rows.Count, "K").End(xlUp).Row
j = WSdata.Cells(Rows.Count, "C").End(xlUp).Row

Application.ScreenUpdating = False


   ws.Range("K5:N" & F).Copy Destination:=WSdata.Range("C" & j + 1)

Application.ScreenUpdating = True

  Next ws

End Sub

 

ترحيل من عدة صفحات V3.xlsm

[2saad]

تسلم يا استاذ محمد وربنا يجعله في ميزان حسناتك