تجميع و دمج عده ملفات عمل اكسيل في ملف عمل واحد

Option Explicit

()Sub CollectWorkbooks
    'تعريف متغير من النوع النصي و اعطيناه اسم
     '( path)
    Dim Path As String
    'تعريف متغير من النوع النصي و اعطيناه اسم
     '(Filename)
    Dim Filename As String
    'تعريف متغير من النوع ورقه عمل و اعطيناه اسم
     ' (SH)
    Dim SH As Worksheet
   '  تعريف المتغير لترتيب اوراق العمل بالترتيب الصحيح و قمنا بافتراض قيمه اسميه له
'x 

  Dim X As Long
    'افترضنا قيمه افتراضيه للمتغير x بقيمه 1
    X = 1
   'تعين المتغير ليحدد مسار الملفات المراد دمجها بجوار مسار الملف الاساسي داخل مخلد test كاسم افتراضي
  
  Path = ThisWorkbook.Path & "\Test\"
   
  'تعين المصنف ليساوي اسم كل مصنف داخل ملف العمل و مسار ملف العمل بصيغه ملف اكسيل ماكرو كضيغه افتراضيه يمكنها حفظ كود العمل
    Filename = Dir(Path & "*.xlsm")
    'الغاء خاصيه اهتتزاز الشاشه
    Application.ScreenUpdating = False
    'الغاء خاصيه الرسائل التنبهيه
    Application.DisplayAlerts = False
        'حلقه تكراريه لحذف ورقه ما عدا ورقه المسار
        For Each SH In ThisWorkbook.Sheets
            If SH.Name <> "Collector" Then SH.Delete
        Next SH
        
        'حلقه تكراريه للمصنفات الموجوده في المسار المحدد الي ان يجد اي مصنف في هذا المسار
        Do While Filename <> ""
            'فتح المصنف
            Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
                'حلقه تكراريه لكل اوراق العمل داخل المصنف النشط
                For Each SH In ActiveWorkbook.Sheets
                    'نسخ ورقه العمل و لصقها بنهايه فهرس اوراق العمل
                    SH.Copy After:=ThisWorkbook.Sheets(X)
                    'زياده قيمه المتغير بمقدار 1
                    X = X + 1
                'الانتقال لورقه العمل التاليه
                Next SH
            'اغلاق المصنف
            Workbooks(Filename).Close
            'اعاده ضبط المتغير
            Filename = Dir()
        Loop
    'تنشيط او تحديد ورقه العمل الاولي
    Sheets("Collector").Activate
    'تفعيل خاصيه التنبيه بالرسائل
    Application.DisplayAlerts = True
    'تفعيل خاصيه اهتزاز الشاشه
    Application.ScreenUpdating = True
End Sub

قد يعجبك ايضا تصميم شيت اليوميه الامريكيه
قد يعجبك ايضا شرح داله البحث الداله vlookup بالامثله و التطبيقات العمليه