كود نسخ بيانات من عدة ملفات الى ملف واحد

[إبراهيم محمد]

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

الى الاستاذة الافاضل عباقرة هذا المنتدي الكريم الذين على ايديهم بدات اتعلم وادخل هذا المجال متمنيا من الله ان اصل ولو 1/100 من مستوى علمهم الغزير 

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

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

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

 

http://chandoo.org/wp/2012/04/09/consolidate-data-from-different-excel-files-vba/

 

 

[طارق محمود]

السلام عليكم

 

بالفعل الملف جيد

ونشكرك أخي الكريم علي مشاركتنا إياه

جزاك الله خيرا

 

لقد حملته ، ووضعت بعض أسماء الملفات التي علي الجهاز عندي

وسأرفعه لمن لم يستطع تحميله من الموقع

 

وجربت الكود وهو يعمل جيدا مع الملاحظات التالية

1. لابد أن تلتزم بالفورمات التي يأخذها الكود ، مثلا الشرطة المايلة بالعكس (\) في آخر مسار الملف المراد نسخه

2. إذا كان المجال (أو الخلية) المنقول إليها غير فارغة ينقل أسفلها مباشرة ولايمسح الأصل ، وهذا له استخدامه بالطبع ويمكنك بعد فهم الكود تعديله كما تشاء

3. الشيت المنقول منه هو الشيت الحالي للملف المنقول منه ، بمعني أن الملف المنقول منه إذا كان به مثلا 3 شيتات وكنت أغلقته آخر مرة علي الشيت الثاني فإن النسخ سيتم من هذا الشيت الثاني (الحالي بالنسبة لذاك الملف)

 

والآن شرح موجز للكود

سأقسم الكود لأجزاء يسهل استيعابها

 

الجزء الأول تعريفات عامة

Public strFileName As String
Public currentWB As Workbook
Public dataWB As Workbook
Public strCopyRange As String

 

الجزء الثاني بداية الكود والتعريفات الداخلية

Sub GetData()
    Dim strWhereToCopy As String, strStartCellColName As String
    Dim strListSheet As String
    
    strListSheet = "List" 

 

الجزء الثالث تأمين الكود في حالة الخطأ في إسم الملف مع رسالة خطأ والنهاية

   On Error GoTo ErrH
...
...


ErrH:
    MsgBox "It seems some file was missing. The data copy operation is not complete."
    Exit Sub
End Sub

 

الجزء الرابع تحديد إسم الملف المنقول منه وذلك من الجدول بالشيت الأساسي List في ملف المنقول إليه

 

 

   Sheets(strListSheet).Select
    Range("B2").Select
    
    'this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
    Set currentWB = ActiveWorkbook

 

الجزء الخامس وكما بالملاحظة الإنجليزي بالجزء السابق هو لووب (حلقة) سيتم من خلالها فتح الملفات المنقول منها واحد بواحد ونسخ البيانات المرادة حسب النطاقات بالجدول ثم غلقها .. حتي انتهاء الحلقة أي حتي يجد الخلية بالعمود B من الجدول فارغة

 

 Do While ActiveCell.Value <> ""
        
        strFileName = ActiveCell.Offset(0, 1) & ActiveCell.Value
        strCopyRange = ActiveCell.Offset(0, 2) & ":" & ActiveCell.Offset(0, 3)
        strWhereToCopy = ActiveCell.Offset(0, 4).Value
        strStartCellColName = Mid(ActiveCell.Offset(0, 5), 2, 1)
        
...
...
    Loop
    Exit Sub 

 

الجزء السادس وهو جزء فرعي من الخامس يعمل علي تحديد أماكن القراءة (النسخ) من الملف المنقول منه ووضع النسخة في مكانها المطلوب

   

 

    Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
        Set dataWB = ActiveWorkbook
        
        Range(strCopyRange).Select
        Selection.Copy
        
        currentWB.Activate
        Sheets(strWhereToCopy).Select
        lastRow = LastRowInOneColumn(strStartCellColName)
        Cells(lastRow + 1, 1).Select
        
        Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        Application.CutCopyMode = False
        dataWB.Close False
        Sheets(strListSheet).Select
        ActiveCell.Offset(1, 0).Select

طبعا لم ادخل في تفاصيل الشرح لاعتقادي أن هذا ماتحتاجه من سؤالك

وإن كان لك اي أسئلة ، فلاتتردد

 

وإليكم الملف

vba-macro-to-copy-data-from-multiple-files.rar

[أبو ردينة]

جزاك الله خيرا أستاذنا الحبيب / Himass و استاذنا الحبيب / طارق 

تعبت كثيرا في موضوع تغيير التنسيق و لكن ما تفضل به أستاذنا / طارق محمود وضح الصورة تماما بارك الله فيه
جاري دراسة أجزاء الكود للتعلم و العودة بالإستفسار إن شاء الله للإستزادة

عجبتين فكرة إحالة الكود في حالة الخطأ إلى ErrH 
 

[إبراهيم محمد]

الاستاذ / الفاضل  طارق محمود 

جزاك الله خيرا على هذا الشرح والتفسير وهذا ما نتوقعه من اساتذة المنتدي العظيم 

ولى استفسار : هل الكود يعمل تلقائيا مع اى ملف فى اى مكان بمجرد كتابه الاسم الصحيح والمسار دون اى تعديل على الكود 

وماذا لو رغبت فى تعديل الصفحه الاولى فاين يكون التعديل بالضبط فى الكود

وجزاك الله خير وزادك الله علما 

[طارق محمود]

السلام عليكم

هل الكود يعمل تلقائيا مع اى ملف فى اى مكان بمجرد كتابه الاسم الصحيح والمسار دون اى تعديل على الكود 

 

نعم يعمل الكود تلقائيا مع اى ملف فى اى مكان دون اى تعديل على الكود 

 

وماذا لو رغبت فى تعديل الصفحه الاولى فاين يكون التعديل بالضبط فى الكود

 

 

ماذا تقصد؟

أن يكون النقل دائما من الصفحه الاولى من الملفات المنقول منها

أم تريد تغيير في الصفحه الاولى للملف المنقول إليه

[إبراهيم محمد]

الاستاذ الفاضل  طارق محمود    المحترم 

بارك الله فيك والاجابه على الجزء الاول من عمل الكود بشكل تلقائي مفيد جدا 

وجزاك الله خيرا استاذى الفاضل  على تفاعلك واهتمامك وشرحك للموضوع 

[samiaa711]

السلام عليكم

شكرا جزيلا على هذه الصفحات

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