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

ma4fd2010 · مايو 21, 2021

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

Acc: Mohamed ElSayed 24 مارس، 2020 اضف تعليق 1,217 زيارة

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

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

و في هذا المقال نستعرض طريقه عمل ذلك بضغطه زر عن طريق كود برمجي مهما كان عدد شيتات العمل الذي نحتاج الي اضافته

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

في البدايه دعنا نتعرف علي طريقه عمل هذا الملف ثم نستعرض فكره عمل هذا الكود كي نتمكن من تطوير هذا الكود في اعمالنا

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

خطوات العمل

دعنا نبدا بنسخ الكود المرفق و فتح ملف الاكسيل الذي نريد اضافه اليه كل الشيتات الاخري

ثم اضغط 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

و بعد الانتهاء تقف الحلقه التكراريه و يقف الكود تم وضع شرح للكود بكافه تفاصيله