Combine Multiple Workbooks into One

Add to Favorites
This macro for Microsoft Excel allows you to combine multiple workbooks and worksheets into one new workbook and worksheet. When the macro runs, it prompts you to select which excel files from your computer you would like to combine and, once you select them and press ok, this macro will pull data from pre-specified worksheets in the selected workbooks and then combine the data onto one worksheet within a new excel workbook. This works quickly and easily and does not require the hard-coding of file names into the macro.

Note: This macro goes into a Module. Also, you will need to change some cell references and worksheet references if you want the macro to work for your specific needs.

Change the number in this line of code With mybook.Worksheets(1) to choose which worksheet you want data to be copied from in the workbook. 1 means the first sheet and 2 the second sheet etc.

Change the cell references in this line of code Set sourceRange = .Range("A1:A25") to the cells you want to be copied from the old worksheet onto the new worksheet.

Change the column reference in this line of code Set destrange = BaseWks.Range("A" & rnum) which is now "A" to whatever column you would like the cells to be imported.

Change this line of code to point to a specific directory where you want the macro to point by default ChDirNet "C:\".

Where to install the macro:  Module

Excel Macro to Combine Multiple Workbooks into One

Private Declare Function SetCurrentDirectoryA Lib _
    "kernel32" (ByVal lpPathName As String) As Long

Sub ChDirNet(szPath As String)
    SetCurrentDirectoryA szPath
End Sub

Sub Combine_Workbooks_Select_Files()
    Dim MyPath As String
    Dim SourceRcount As Long, Fnum As Long
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim rnum As Long, CalcMode As Long
    Dim SaveDriveDir As String
    Dim FName As Variant

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    SaveDriveDir = CurDir
    ChDirNet "C:\"

    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
                                        MultiSelect:=True)
    If IsArray(FName) Then
        Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
        rnum = 1
        For Fnum = LBound(FName) To UBound(FName)
            Set mybook = Nothing
            On Error Resume Next
            Set mybook = Workbooks.Open(FName(Fnum))
            On Error GoTo 0
            If Not mybook Is Nothing Then
                On Error Resume Next
                With mybook.Worksheets(1)
                    Set sourceRange = .Range("A1:A25")
                End With
                If Err.Number > 0 Then
                    Err.Clear
                    Set sourceRange = Nothing
                Else
        If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
                        Set sourceRange = Nothing
                    End If
                End If
                On Error GoTo 0

                If Not sourceRange Is Nothing Then

                    SourceRcount = sourceRange.Rows.Count

                    If rnum + SourceRcount >= BaseWks.Rows.Count Then
                        MsgBox "Not enough rows in the sheet. "
                        BaseWks.Columns.AutoFit
                        mybook.Close savechanges:=False
                        GoTo ExitTheSub
                    Else
                        Set destrange = BaseWks.Range("A" & rnum)
                        With sourceRange
                            Set destrange = destrange. _
                                            Resize(.Rows.Count, .Columns.Count)
                        End With
                        destrange.Value = sourceRange.Value

                        rnum = rnum + SourceRcount
                    End If
                End If
                mybook.Close savechanges:=False
            End If
        Next Fnum
        BaseWks.Columns.AutoFit
    End If
ExitTheSub:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
    ChDirNet SaveDriveDir
End Sub






How to Install the Macro
  1. Select and copy the text from within the grey box above.

  2. Open the Microsoft Excel file in which you would like the Macro to function.

  3. Press "Alt + F11" - This will open the Visual Basic Editor - Works for all Excel Versions.  Or For other ways to get there, Click Here.

  4. On the new window that opens up, go to the left side where the vertical pane is located. Locate your Excel file; it will be called VBAProject (YOUR FILE'S NAME HERE) and click this.

  5. If the Macro goes in a Module, Click Here, otherwise continue to Step 8.

  6. If the Macro goes in the Workbook or ThisWorkbook, Click Here, otherwise continue to Step 8.

  7. If the Macro goes in the Worksheet Code, Click Here, otherwise continue to Step 8.

  8. Close the Microsoft Visual Basic Editor window and save the Excel file. When you close the Visual Basic Editor window, the regular Excel window will not close.

  9. You are now ready to run the macro.


Subscribe for Free Excel tips & more!
E-mail: