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

شريط الاخبار

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


كثيرا من الاحيان نحتاج في اعمالنا اليوميه الي تجميع و دمج عده ملفات عمل اكسيل في ملف عمل لنتعامل مع ملف واحد بدلا من التعامل مع عده ملفات و في هذا المقال نستعرض طريقه عمل ذلك بضغطه زر عن طريق كود برمجي مهما كان عدد شيتات العمل الذي نحتاج الي اضافته
في البدايه دعنا نتعرف علي طريقه عمل هذا الملف ثم نستعرض فكره عمل هذا الكود كي نتمكن من تطوير هذا الكود في اعمالنا فالاهم من مجرد تطبيق اي كود هو فهمه كي نستطيع التعامل مع هذا الكود
دعنا نبدا بنسخ الكود المرفق و فتح ملف الاكسيل الذي نريد اضافه اليه كل الشيتات الاخري ثم اضغط Alt + F11    او  اضغط ضغطه بزر الماوس الايمن علي اسم الشيت ثم اختر view code  ليفتح محرر الاكواد







ثم اختر من قائمه insert   اختر module




ثم قم بلصق الكود بعد ذلك قم بالحفظ و اغلق محرر الاكواد ثم انتقل الي الاكسيل و قم باختيرا save as  من خلال القائمه file  و غير صيغه الملف file type  الي اي صيغه تقبل الكود و ليكن الصيغه xlsm 

الصيغه excel Macro-Enabled Workbook

هي صيغه تتيح حفظ الاكواد و الوحدات النمطيه و النماذج داخل شيت العمل و تاخذ الامتداد .Xlsm  




بعد ذلك قم بنسخ هذا الملف داخل مجلد فارغ و قم بعمل مجلد اخر داخل هذا المجلد الفارغ و قم باعده تسميه هذا الملف الي اسم 


test  ثم قم بوضع كل الملفات المراد دمجها  الي مجلد test الجديد
ثم انتقل الي ملف العمل الموجود به الكود و افتحه اضغط علي macro  من خلال 

القائمه view  اختر CollectWorkbooks اسم الماكرو الذي قمنا باضافته عن طريق الكود بمجرد عمل هذا الكود ينتقل كافه شيتات العمل من المجلد test  الي الشيت المفتوح بنفس الترتيب خلال ثواني


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

حيث ان هذا الكود يقوم بعمل حلقه تكراريه علي اسماء الشيتات داخل المجلد test  و البدا باول شيت ثم اعاده عمل حلقه تكراريه اخري جديده علي اسماء الشيتات الموجوده في هذا الشيت لنقلها بالترتيب و بعد الانهاء يقوم باغلاق ملف الاكسيل الاول و الانتقال الي الحلقه التكراريه الاولي لياخذ الملف التالي و يعود و يكرر نفس الحلقه التكراريه حتي ينتهي من كل ملفات الاكسيل داخل المجلد test  و بعد الانتهاء تقف الحلقه التكراريه و يقف الكود تم وضع شرح للكود بكافه تفاصيله


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

ليست هناك تعليقات