• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Integrating multiple excel in folder to a single workbook

K

Kumar Salui

New Member
Hello Team,
I am trying to integrate 200+ excel workbooks into a single workbook. Each workbook has multiple worksheets. The idea is each worksheet will be appended except the header (1st row). So 10 child worksheets (every worksheet may have a different number of rows) in 200+ workbooks will have a single master workbook with 10 master worksheets. Does anyone have any idea how to implement it?

Thank you all in advance.
Kind regards,
Kumar
 
hi
COMBINE Multiple Excel WORKBOOKS into One | ExcelJunction.com
Combine Data from Multiple Excel Files in a Single Excel Sheet - Part 1
Excel - Combining Data from Multiple Workbooks (files) into One Worksheet - Basic Power Query
and you can Used this Code with example
Code: 
Sub MergeExcelFiles()
    Dim fnameList, fnameCurFile As Variant
    Dim countFiles, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook, wbkSrcBook As Workbook

    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)

    If (vbBoolean <> VarType(fnameList)) Then

        If (UBound(fnameList) > 0) Then
            countFiles = 0
            countSheets = 0

            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual

            Set wbkCurBook = ActiveWorkbook

            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1

                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)

                For Each wksCurSheet In wbkSrcBook.Sheets
                    countSheets = countSheets + 1
                    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                Next

                wbkSrcBook.Close SaveChanges:=False

            Next

            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic

            MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If

    Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
End Sub
and elso another code you can to Use It
Code: 
Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = Environ("userprofile") & "DesktopTest"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
 Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
 For Each Sheet In ActiveWorkbook.Sheets
 Sheet.Copy After:=ThisWorkbook.Sheets(1)
 Next Sheet
 Workbooks(Filename).Close
 Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub
 

Attachments

  • excel-merge-files-macro.xlsm
    70.7 KB · Views: 11
Last edited:
Hi Herefox,
Thank you for sharing this. But I am looking to merge the data and not just bringing the sheets one after another. For example, lets say, workbook 1 sheet 1 has 6 lines, work book 2 sheet 1 has 5 lines, work book 3 sheet 1 has 10 lines. So the merged sheet should have 106+5+10 = 21 lines of data.
Thanks
Kumar
 
herofox said:
hi
COMBINE Multiple Excel WORKBOOKS into One | ExcelJunction.com
Combine Data from Multiple Excel Files in a Single Excel Sheet - Part 1
Excel - Combining Data from Multiple Workbooks (files) into One Worksheet - Basic Power Query
and you can Used this Code with example
Code: 
Sub MergeExcelFiles()
    Dim fnameList, fnameCurFile As Variant
    Dim countFiles, countSheets As Integer
    Dim wksCurSheet As Worksheet
    Dim wbkCurBook, wbkSrcBook As Workbook

    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)

    If (vbBoolean <> VarType(fnameList)) Then

        If (UBound(fnameList) > 0) Then
            countFiles = 0
            countSheets = 0

            Application.ScreenUpdating = False
            Application.Calculation = xlCalculationManual

            Set wbkCurBook = ActiveWorkbook

            For Each fnameCurFile In fnameList
                countFiles = countFiles + 1

                Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)

                For Each wksCurSheet In wbkSrcBook.Sheets
                    countSheets = countSheets + 1
                    wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
                Next

                wbkSrcBook.Close SaveChanges:=False

            Next

            Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic

            MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
        End If

    Else
        MsgBox "No files selected", Title:="Merge Excel files"
    End If
End Sub
and elso another code you can to Use It
Code: 
Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = Environ("userprofile") & "DesktopTest"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Click to expand...


Hi Herefox,
Thank you for sharing this. But I am looking to merge the data and not just bringing the sheets one after another. For example, lets say, workbook 1 sheet 1 has 6 lines, work book 2 sheet 1 has 5 lines, work book 3 sheet 1 has 10 lines. So the merged sheet should have 106+5+10 = 21 lines of data.
Thanks
Kumar
 
Hi
this do the thing for one Sheet <<Sheet1>>
Code: 
Sub Merge_Ku()
    Dim fDialog As FileDialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    Dim wbk As Workbook
    Dim a As Variant
    Dim i, lr As Integer
    On Error Resume Next
    With fDialog
        .AllowMultiSelect = True
        .Title = "Please select the files"
        .Filters.Clear
        .Filters.Add "All supported files", "*.xlsm"
        .Filters.Add "Text Files", "*.xlsx"
        If .Show = True Then
            Dim fPath As Variant
            i = 1
            ReDim a(1 To .SelectedItems.Count)
            For Each fPath In .SelectedItems
                Set wbk = Workbooks.Open(Filename:=fPath)
                With wbk
                    a(i) = .Sheets("Draft").UsedRange.Columns("a:e").Value
                    i = i + 1
                End With
                wbk.Close savechanges:=False
            Next
        End If
    End With
    For i = 1 To UBound(a)
        With Sheets("Sheet1")
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        Cells(lr, 1).Resize(UBound(a(i)), UBound(a(i), 2)) = a(i)
          End With
    Next
End Sub
 
mohadin said:
Hi
this do the thing for one Sheet <<Sheet1>>
Code: 
Sub Merge_Ku()
    Dim fDialog As FileDialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    Dim wbk As Workbook
    Dim a As Variant
    Dim i, lr As Integer
    On Error Resume Next
    With fDialog
        .AllowMultiSelect = True
        .Title = "Please select the files"
        .Filters.Clear
        .Filters.Add "All supported files", "*.xlsm"
        .Filters.Add "Text Files", "*.xlsx"
        If .Show = True Then
            Dim fPath As Variant
            i = 1
            ReDim a(1 To .SelectedItems.Count)
            For Each fPath In .SelectedItems
                Set wbk = Workbooks.Open(Filename:=fPath)
                With wbk
                    a(i) = .Sheets("Draft").UsedRange.Columns("a:e").Value
                    i = i + 1
                End With
                wbk.Close savechanges:=False
            Next
        End If
    End With
    For i = 1 To UBound(a)
        With Sheets("Sheet1")
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        Cells(lr, 1).Resize(UBound(a(i)), UBound(a(i), 2)) = a(i)
          End With
    Next
End Sub
Click to expand...

Hello Moadin,

This works! Many thanks for help.
Take care.

Regards,
Kumar
 
You must log in or register to reply here.
Back
Top