طريقة دمج عدة ملفات إكسل داخل فولدر لتكون في ملف إكسل واحد وتجميع البيانات

[MrSeen]

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

كل عام والجميع بالف صحة وسلامة , عيد سعيد للجميع

لدي عدد 97 ملف إكسل منفصل داخل فولدر , هذه الملفات عبارة عن بيانات للاصناف وكمياتها الواردة للمستودعات لدي , بعض هذه الاصناف متكرره في بعض الملفات

أرغب بتجميع تلك الملفات و الاصناف وكميتها بحيث تكون في ملف واحد , بحيث يكون في ملف التجميع رقم الصنف وامامة المجموع الكلي للكميات الواردة 

 

يوجد مثال في المرفقات

 

اتمني ان اكون وفقت في ايصال الاستفسار بشكل دقيق 

 

شاكر لكم مقدما

 

1.xlsx 2.xlsx 3.xlsx 4.xlsx TOTAL.xlsx

[abouelhassan]

بالنسبة للتجميع هذاا الملفل للاستاذ الاسطورة ياسر خليل ابو البراء لعله ينفعك يقوم بتجميع الشيتات

مع الشكر

 

Collect Data From Multiple CSV Workbooks Mokhtar V1.rar

[MrSeen]

تسلم الايادي استاذ ابو الحسن

 

- الملف الي اضفته يقوم بتجميع كل ملف إكسل في ملف واحد ولكن كل ملف يقوم بوضعة في شيت مستقل

- الذي ابحث عنه هو ان يقوم بتجميعهم بملف واحد وشيت واحد 

 

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

 

- السؤال الان يوجد في الشيت اصناف متكرره بأعداد مختلفه, كيف اقوم بدمج هذه الاصناف بحيث يكون صنف واحد وامامه المجموع لكلي ؟

[abouelhassan]

شوف الفيديو يمكن يفيدك اخى

 

[عبدالفتاح في بي اكسيل]

جرب هذا  الكود  لعله  يفي  بالغرض 

Sub Consolidation()

Dim CurrentBook As Workbook
Dim WS As Worksheet
Set WS = ThisWorkbook.Sheets("sheet1")
Dim IndvFiles As FileDialog
Dim FileIdx As Long
Dim i As Integer, x As Integer

Set IndvFiles = Application.FileDialog(msoFileDialogOpen)
With IndvFiles
    .AllowMultiSelect = True
    .Title = "Multi-select target data files:"
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xlsx files", "*.xlsx"
    .Show
End With

Application.DisplayAlerts = False
Application.ScreenUpdating = False

For FileIdx = 1 To IndvFiles.SelectedItems.Count
    Set CurrentBook = Workbooks.Open(IndvFiles.SelectedItems(FileIdx))
    For Each Sheet In CurrentBook.Sheets
        Dim LRow1 As Long
        LRow1 = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
        Dim LRow2 As Long
        LRow2 = CurrentBook.ActiveSheet.Range("A" & CurrentBook.ActiveSheet.Rows.Count).End(xlUp).Row

        Dim ImportRange As Range
        Set ImportRange = CurrentBook.ActiveSheet.Range("A2:d" & LRow2)

        ImportRange.Copy
        WS.Range("A" & LRow1 + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next
    CurrentBook.Close False
Next FileIdx

Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub