Office development
The topic you requested is included in another documentation set. For convenience, it's displayed below. Choose Switch to see the topic in its original location.

# Merging Data from Multiple Workbooks into a Summary Workbook in Excel

Office 2007

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

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.

' 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
Else
' Set a range without the
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), _

```

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.