اذهب الي المحتوي
أوفيسنا

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


الردود الموصى بها

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

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

 

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

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

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

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

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

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

خطوات العمل

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

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

 
 
view2Bcode.jpg?w=618&ssl=1
ثم اختر من قائمه insert   اختر module
module-1.jpg?resize=327%2C166&ssl=1

ثم قم بلصق الكود بعد ذلك قم بالحفظ و اغلق محرر الاكواد ثم انتقل الي الاكسيل و قم باختيرا 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 بالامثله و التطبيقات العمليه

المصدر موقع المحاسب العربي

https://acc-arab.com/2020/03/blog-post_24-2.html

  • Like 5
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • المتواجدين الان   0 اعضاء متواجدين الان

    لايوجد اعضاء مسجلون يتصفحون هذه الصفحه

×
×
  • اضف...

Important Information