Excel Macro to Combine Multiple Spreadsheets Into One

Excel Macro to Combine Multiple Spreadsheets Into One

October 13, 2016

In this video:

 

 

 

 

 

 

. . . .I have posted to my YouTube channel tonight I show you how to use a macro to automatically combine multiple Excel Files.   The macro itself is available at the Microsoft Office Dev Center here:  https://msdn.microsoft.com/en-us/library/office/cc837974(v=office.12).aspx

 

 

    Sub MergeAllWorkbooks()

    Dim MyPath As String, FilesInPath As String

    Dim MyFiles() 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

 

    ' Change this to the path\folder location of your files.

    MyPath = "C:\Users\Ron\test"

 

    ' Add a slash at the end of the path if needed.

    If Right(MyPath, 1) <> "\" Then

        MyPath = MyPath & "\"

    End If

 

    ' If there are no Excel files in the folder, exit.

    FilesInPath = Dir(MyPath & "*.xl*")

    If FilesInPath = "" Then

        MsgBox "No files found"

        Exit Sub

    End If

 

    ' Fill the myFiles array with the list of Excel files

    ' in the search folder.

    FNum = 0

    Do While FilesInPath <> ""

        FNum = FNum + 1

        ReDim Preserve MyFiles(1 To FNum)

        MyFiles(FNum) = FilesInPath

        FilesInPath = Dir()

    Loop

 

    ' Set various application properties.

    With Application

        CalcMode = .Calculation

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

        .EnableEvents = False

    End With

 

    ' Add a new workbook with one sheet.

    Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

    rnum = 1

 

    ' Loop through all files in the myFiles array.

    If FNum > 0 Then

        For FNum = LBound(MyFiles) To UBound(MyFiles)

            Set mybook = Nothing

            On Error Resume Next

            Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))

            On Error GoTo 0

 

            If Not mybook Is Nothing Then

                On Error Resume Next

 

                ' Change this range to fit your own needs.

                With mybook.Worksheets(1)

                    Set sourceRange = .Range("A1:C1")

                End With

 

                If Err.Number > 0 Then

                    Err.Clear

                    Set sourceRange = Nothing

                Else

                    ' If source range uses all columns then

                    ' skip this file.

                    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 "There are not enough rows in the target worksheet."

                        BaseWks.Columns.AutoFit

                        mybook.Close savechanges:=False

                        GoTo ExitTheSub

                    Else

 

                        ' Copy the file name in column A.

                        With sourceRange

                            BaseWks.Cells(rnum, "A"). _

                                    Resize(.Rows.Count).Value = MyFiles(FNum)

                        End With

 

                        ' Set the destination range.

                        Set destrange = BaseWks.Range("B" & rnum)

 

                        ' Copy the values from the source range

                        ' to the destination range.

                        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:

    ' Restore the application properties.

    With Application

        .ScreenUpdating = True

        .EnableEvents = True

        .Calculation = CalcMode

    End With

End Sub

 


 

In Excel you open Visual Basic by pressing ALT + F11.   Then right click on the Modules folder and select Insert . . .  Module, and just paste the VBA code in.    


In this demo, we're going to use three Excel files.   The files have the same kind of data in an equal number of rows. 

Each has data in columns A to K and none has more than 25 rows.

 

 

 

 

 

 

 


Several lines down into the macro we need to designate the path to the folder which contains the Excel files we want to combine.

See the line which begins:
 My Path =

 

 

 

 


Next we scroll down to the line beginning:

Set sourceRange =

. . . and enter the cell range in which data is to be collected from in all of the source spreadsheets.  In this demo the range will be A1:K25.

 

 

 


As we can see the data from all three spreadsheets is combined on a new spreadsheet.

The macro also creates a new field in column A of the merged spreadsheet containing the file name of the source file.

 

 

 

Please reload

Contact Me With Your Litigation Support Questions:

seankevinoshea@hotmail.com

  • Twitter Long Shadow

© 2015 by Sean O'Shea . Proudly created with Wix.com