Merging Data from Multiple Workbooks into a Summary Workbook in Excel

Summary: Microsoft Office Excel MVP Ron de Bruin provides a number of samples and a handy add-in to merge data from multiple workbooks located in one folder into a summary workbook. (13 printed pages)

Ron de Bruin, Microsoft Office Excel MVP

Frank Rice, Microsoft Corporation

August 2008

Applies to:   Microsoft Office Excel 2007, Microsoft Office Excel 2003, Microsoft Excel 2002, Microsoft Excel 2000

Contents

• Overview

• Finding the Last Cell, Column, or Row in a Range

• Merging a Range from All Workbooks in a Folder

• Merging a Range from Selected Workbooks

• Merging a Range from Multiple Workbooks by Column

• Merging a Range from Multiple Workbooks in a Folder with a Filter

• More Options for Working with Workbooks

• The RDBMerge Utility

• Conclusion

• Additional Resources

• About the Authors

Overview

When working with multiple Microsoft Office Excel workbooks, a common task is to roll-up or merge the data in each workbook into a master workbook. The examples described in this article add the data from multiple workbooks to a summary workbook. The different procedures demonstrate techniques for pasting the data by row or by column. Additionally, you will see how to retrieve data by using a filter. And finally, you will see a utility that pulls all of these techniques together and more in one location.

You can download workbooks containing the code in this article at Ron de Bruin's Web site.

Finding the Last Cell, Column, or Row in a Range

The following code is used in some of the examples in this article.

To find the last cell, column, or row in a range

1. Open a new workbook in Excel.

2. Press Alt+F11 to open the Visual Basic Editor.

3. On the Insert menu, click Module to add a module to the workbook.

4. In the module window, type or paste the following function and then press Alt+Q to close the Visual Basic Editor.

Function RDB_Last(choice As Integer, rng As Range)
' By Ron de Bruin, 5 May 2008
' A choice of 1 = last row.
' A choice of 2 = last column.
' A choice of 3 = last cell.
   Dim lrw As Long
   Dim lcol As Integer

   Select Case choice

   Case 1:
      On Error Resume Next
      RDB_Last = rng.Find(What:="*", _
                          after:=rng.cells(1), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
      On Error GoTo 0

   Case 2:
      On Error Resume Next
      RDB_Last = rng.Find(What:="*", _
                          after:=rng.cells(1), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByColumns, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Column
      On Error GoTo 0

   Case 3:
      On Error Resume Next
      lrw = rng.Find(What:="*", _
                    after:=rng.cells(1), _
                    Lookat:=xlPart, _
                    LookIn:=xlFormulas, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlPrevious, _
                    MatchCase:=False).Row
      On Error GoTo 0

      On Error Resume Next
      lcol = rng.Find(What:="*", _
                     after:=rng.cells(1), _
                     Lookat:=xlPart, _
                     LookIn:=xlFormulas, _
                     SearchOrder:=xlByColumns, _
                     SearchDirection:=xlPrevious, _
                     MatchCase:=False).Column
      On Error GoTo 0

      On Error Resume Next
      RDB_Last = rng.Parent.cells(lrw, lcol).Address(False, False)
      If Err.Number > 0 Then
         RDB_Last = rng.cells(1).Address(False, False)
         Err.Clear
      End If
      On Error GoTo 0

   End Select
End Function

This function uses the Range object's Find method to search for the last item in the workbook depending on the value of the choice argument. The choice argument specifies a cell, column, or row.

Merging a Range from All Workbooks in a Folder

To merge data from all workbooks in a folder, type or paste the following code in standard module in the Visual Basic Editor. The ranges are concatenated into the target worksheet, one after another, in rows.

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

This procedure fills an array with the path and name of each workbook in a folder. It then loops through the array and for each source file, checks the source and target ranges to see if there are more columns used in the source range than are available in the target range. If this is true, then this workbook is skipped and the code moves to the next workbook. The code then does the same test for the rows in the source range.

Next the procedure copies the path and name of the source workbook into column A. Finally, the values in the source range are copied into the corresponding range in the target workbook and the code moves to the next file in the array.

This procedure uses the first worksheet (index 1) of each workbook. To start with a different worksheet to use a specific worksheet, just change the index number or change the index to the name of the worksheet.

With mybook.Worksheets("YourSheetName")

You will also likely want to change the range A1:C1 to your own values.

With mybook.Worksheets(1)
    Set sourceRange = .Range("A1:C1")
End With

If you want to copy from cell A2 until the last cell on the worksheet then replace this code with the following code. You might do this if there are headers in the first row.

Note
If you use this procedure, copy the function RDB_Last into your code module.

First, add this line at the top of the macro.

Dim FirstCell As String

Then add this code.

With mybook.Worksheets(1)
   FirstCell = "A2"
   Set sourceRange = .Range(FirstCell & ":" & RDB_Last(3, .Cells))
   ' Test if the row of the last cell is equal to or greater than the row of the first cell.
   If RDB_Last(1, .Cells) < .Range(FirstCell).Row Then
      Set sourceRange = Nothing
   End If
End With

Merging a Range from Selected Workbooks

To merge data from specific workbooks, type or paste the following code in the module code window.

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

Sub ChDirNet(szPath As String)
    SetCurrentDirectoryA szPath
End Sub


Sub MergeSpecificWorkbooks()
    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


    ' Set application properties.
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    SaveDriveDir = CurDir
    ' Change this to the path\folder location of the files.
    ChDirNet "C:\Users\Ron\test"

    FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
                                        MultiSelect:=True)
    If IsArray(FName) Then

        ' Add a new workbook with one sheet.
        Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
        rnum = 1


        ' Loop through all files in the myFiles array.
        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:C1")
                End With

                If Err.Number > 0 Then
                    Err.Clear
                    Set sourceRange = Nothing
                Else
                    ' If the 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 = FName(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
    ChDirNet SaveDriveDir
End Sub

This code example will do the same thing as the first example only you are able to select the files you want to merge. The function ChDirNet is used so that you can set the starting path to the network folder of your choice. You can also change the worksheet and range by using the changes described in the first example.

Merging a Range from Multiple Workbooks by Column

To paste data from source workbooks horizontally (in columns) in a target workbook, type or paste the following code in the module code window.

Sub MergeHorizontally()
    Dim MyPath As String, FilesInPath As String
    Dim MyFiles() As String
    Dim SourceCcount As Long, FNum As Long
    Dim mybook As Workbook, BaseWks As Worksheet
    Dim sourceRange As Range, destrange As Range
    Dim Cnum As Long, CalcMode As Long

    ' Change this to the path\folder location of the files.
    MyPath = "C:\Users\Ron\test"

    ' Add a slash at the end of 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 in 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

    ' Change the 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)
    Cnum = 1

    ' Loop through all of the 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
                Set sourceRange = mybook.Worksheets(1).Range("A1:A10")

                If Err.Number > 0 Then
                    Err.Clear
                    Set sourceRange = Nothing
                Else
                    ' If the source range uses all of the rows 
                    ' then skip this file.
                    If sourceRange.Rows.Count >= BaseWks.Rows.Count Then
                        Set sourceRange = Nothing
                    End If
                End If
                On Error GoTo 0

                If Not sourceRange Is Nothing Then

                    SourceCcount = sourceRange.Columns.Count

                    If Cnum + SourceCcount >= BaseWks.Columns.Count Then
                        MsgBox "There are not enough columns in the sheet."
                        BaseWks.Columns.AutoFit
                        mybook.Close savechanges:=False
                        GoTo ExitTheSub
                    Else

                        ' Copy the file name in the first row.
                        With sourceRange
                            BaseWks.Cells(1, Cnum). _
                                    Resize(, .Columns.Count).Value = MyFiles(FNum)
                        End With

                        ' Set the destination range.
                        Set destrange = BaseWks.Cells(2, Cnum)

                        ' 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

                        Cnum = Cnum + SourceCcount
                    End If
                End If
                mybook.Close savechanges:=False
            End If

        Next FNum
        BaseWks.Columns.AutoFit
    End If

ExitTheSub:
    'Restore ScreenUpdating, Calculation and EnableEvents
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With

End Sub

The following line is where columns are specified as the target as opposed to rows.

Set destrange = BaseWks.Cells(2, Cnum)

Merging a Range from Multiple Workbooks in a Folder with a Filter

To merge data retrieved based on a filter, type or paste the following code in the module code window.

Sub MergewithAutoFilter()
    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
    Dim rng As Range, SearchValue As String
    Dim FilterField As Integer, RangeAddress As String
    Dim ShName As Variant, RwCount As Long

    '**************************************************************
    '***Change these five lines of code before you run the macro***
    '**************************************************************

    ' Change this to the path\folder location of the files.
    MyPath = "C:\Users\Ron\test"

    ' Fill in the name of the sheet containing the data.
    ' Use ShName = "Sheet Name" to use a sheet name instead if its 
    ' index. This example uses the index of the first sheet in 
    ' every workbook.
    ShName = 1

    ' Fill in the filter range: A1 is the header of the first 
    ' column and G is the last column in the range and will
    ' filter on all rows on the sheet.
    ' You can also use a fixed range such as A1:G2500.
    RangeAddress = Range("A1:G" & Rows.Count).Address

    ' Set the field that you want to filter in the range 
    ' "1 = column A" in this example because the filter range 
    ' starts in column A.
    FilterField = 1

    ' Fill in the filter value. Use the "<>" if you want to 
    ' filter on the absence of a term. Or use wildcards such
    ' as "ron*" for cells that start with ron, or use
    ' "*ron*" if you look for cells where ron is a part of the
    ' cell value.
    SearchValue = "ron"

    '**********************************************************
    '**********************************************************


    ' Add a slash after MyPath 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
    ' folder.
    FNum = 0
    Do While FilesInPath <> ""
        FNum = FNum + 1
        ReDim Preserve MyFiles(1 To FNum)
        MyFiles(FNum) = FilesInPath
        FilesInPath = Dir()
    Loop

    ' Change 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
                ' Set the filter range.
                With mybook.Worksheets(ShName)
                    Set sourceRange = .Range(RangeAddress)
                End With

                If Err.Number > 0 Then
                    Err.Clear
                    Set sourceRange = Nothing
                End If
                On Error GoTo 0

                If Not sourceRange Is Nothing Then
                    ' Find the last row in target worksheet.
                    rnum = RDB_Last(1, BaseWks.Cells) + 1

                    With sourceRange.Parent
                        Set rng = Nothing

                        ' Remove the AutoFilter.
                        .AutoFilterMode = False

                        ' Filter the range on the 
                        ' value in filter column.
                        sourceRange.AutoFilter Field:=FilterField, _
                                               Criteria1:=SearchValue

                        With .AutoFilter.Range

                            ' Check to see if there are results
                            ' after after applying the filter.
                            RwCount = .Columns(1).Cells. _
                                      SpecialCells(xlCellTypeVisible).Cells.Count - 1

                            If RwCount = 0 Then
                                ' There is no data, only the 
                                ' header.
                            Else
                                ' Set a range without the 
                                ' header row.
                                Set rng = .Resize(.Rows.Count - 1, .Columns.Count). _
                                          Offset(1, 0).SpecialCells(xlCellTypeVisible)


                                ' Copy the range and the file name
                                ' in column A.
                                If rnum + RwCount < BaseWks.Rows.Count Then
                                    BaseWks.Cells(rnum, "A").Resize(RwCount).Value _
                                          = mybook.Name
                                    rng.Copy BaseWks.Cells(rnum, "B")
                                End If
                            End If

                        End With

                        'Remove the AutoFilter
                        .AutoFilterMode = False

                    End With
                End If

                ' Close the workbook without saving.
                mybook.Close savechanges:=False
            End If

            ' Open the next workbook.
        Next FNum

        ' Set the column width in the new workbook.
        BaseWks.Columns.AutoFit
        MsgBox "Look at the merge results in the new workbook " & _
           "after you click on OK."
    End If

    ' Restore the application properties.
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With
End Sub

In this example, the following line of code is used to search for data matching the search term.

sourceRange.AutoFilter Field:=FilterField, Criteria1:=SearchValue

More Options for Working with Workbooks

In the previous paragraphs, four code examples for working for files in one folder were discussed. Minor changes to these examples can make them even more useful. For example, if your workbooks are password protected, you can replace the Workbooks.Open arguments with the following code to open them.

Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum), _
   Password:="ron", WriteResPassword:="ron", UpdateLinks:=0)

If you have links in your workbook to other workbooks, the setting UpdateLinks:=0 will avoid the message of whether you want to update the links. Use the value 3 if you do want to update the links.

Another change you can make is to merge from all files with a name that starts with a specific name. For example, you can use the following statement to find all workbooks that start with week.

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

You can find more information and code sample for merging the data in the subfolders and looping through all worksheets in every workbook at the following location on Ron de Bruin's Web site.

The RDBMerge Utility

The RDBMerge utility provides a user friendly way to merge data from workbooks in a folder into one worksheet in a new workbook. Working with the add-in is very easy; however, for more information, see the page on Ron de Bruin's Web site.

To install the RDBMerge utility

1. Navigate to the RDBMerge utility page.

2. Download and extract the zip file to a local directory on your computer.

3. Copy either RDBMerge.xlam or RDBMerge.xla, depending on whether you are using the 2007 release of Microsoft Office or a previous version of Microsoft Office, respectively, to the following directory:

   local_drive:\Program Files\Microsoft Office\Version_Number\Library

   Note

   Depending on the version of Excel you are using, the Version_Number directory may be named just Office or may include a version number. For example: local_drive:\Program Files\Microsoft Office\Office\Library or local_drive:\Program Files\Microsoft Office\Office11\Library.

   Once the utility is installed, do the following to access it:

4. Start Excel and open a workbook.

5. (Excel 2007 only) Click the Microsoft Office button, click Excel Options, and then click the Add-Ins tab. In the Manage drop-down list, click Excel Add-ins, and then click Go. Verify that RDBMerge is selected in this list and then click OK.

6. (Excel 2000-2003 only) Click Tools, click Add-Ins, verify RDBMerge is selected in the list, and then click OK.

Conclusion

In this article, you explored several code samples that you can use to merge data from all workbooks in a folder into a master workbook. Additionally, the RDBMerge add-in can assist you to do this task very easy. Exploring and implementing these tools in your own applications can help make your job as a developer easier and make your solutions more versatile.

Additional Resources

You can find more information on the concepts and techniques discussed in this article at the following locations.

• Create a summary worksheet from all worksheets (with formulas)

• Copy a range from closed workbooks by using ADO

• Microsoft Office Developer Center

• Excel Developer Portal

About the Authors

Ron de Bruin is an Excel Most Valuable Professional (MVP) and a frequent contributor to the newsgroups. For more information, see Ron's Excel Web page.

Frank Rice is a programming writer and frequent contributor to the Microsoft Office Developer Center.