Summary: Microsoft Office Excel MVP Ron de Bruin provides a number of samples to merge data from multiple worksheets into one summary worksheet. After you have all the data on one worksheet, you can do things such as build a PivotTable report based on your specific criteria or use the filter options in Excel 2007 to get the results you want. (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
-
Copying a Range from Multiple Worksheets
-
Copying All Data Except Column Headers from Multiple Worksheets
-
Appending Data After the Last Column in the Summary Worksheet
-
Conclusion
-
Additional Resources
-
About the Authors
Overview
When you use workbooks that contain multiple worksheets, a common task is to roll up or consolidate the data in each worksheet into a summary worksheet. The samples described in this article add a worksheet to the active workbook and then copy a range of cells from every worksheet to the summary worksheet. The different procedures demonstrate techniques for copying varying size ranges as well as placing the data at specific locations in the summary sheet.
You can download a workbook that contains the code in this article at Ron de Bruin's Web site.
Note The code in the following examples use the ActiveWorkbook object to work in the active workbook. If you want to ensure that the code will work only in the workbook that contains the code, replace every instance of ActiveWorkbook with ThisWorkbook.
First, you need to add functions that are common to all of the samples in this article.
To add functions that are common to all samples
-
Open a new workbook in Excel.
-
Press Alt+F11 to open the Visual Basic Editor.
-
On the Insert menu, click Module to add a module to the workbook.
-
In the module window, type or paste the following functions.
Function LastRow(sh As Worksheet) On Error Resume Next LastRow = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Function Function LastCol(sh As Worksheet) On Error Resume Next LastCol = sh.Cells.Find(What:="*", _ After:=sh.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Column On Error GoTo 0 End Function
These two functions are used to find the last row and column, respectively, with data.
Copying a Range from Multiple Worksheets
In the following steps, you copy a range of data from all worksheets in a workbook and consolidate the data into a summary worksheet.
To copy data from all rows in multiple worksheets
-
Type or paste the following code into the module code window.
Visual BasicSub CopyRangeFromMultiWorksheets() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim CopyRng As Range With Application .ScreenUpdating = False .EnableEvents = False End With ' Delete the summary sheet if it exists. Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True ' Add a new summary worksheet. Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "RDBMergeSheet" ' Loop through all worksheets and copy the data to the ' summary worksheet. For Each sh In ActiveWorkbook.Worksheets If sh.Name <> DestSh.Name Then ' Find the last row with data on the summary worksheet. Last = LastRow(DestSh) ' Specify the range to place the data. Set CopyRng = sh.Range("A1:G1") ' Test to see whether there are enough rows in the summary ' worksheet to copy all the data. If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then MsgBox "There are not enough rows in the " & _ "summary worksheet to place the data." GoTo ExitTheSub End If ' This statement copies values and formats from each ' worksheet. CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With ' Optional: This statement will copy the sheet ' name in the H column. DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name End If Next ExitTheSub: Application.Goto DestSh.Cells(1) ' AutoFit the column width in the summary sheet. DestSh.Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With End Sub
-
Press Alt+Q to exit the Visual Basic Editor.
-
Press Alt+F8 to run the code.
The code at the beginning of this procedure (as well as the code in the samples that follow) disables screen updating so that the screen does not flicker when the code is running. It also deletes the summary worksheet RDBMergeSheet, if it exists, and then adds a new sheet to the workbook. This ensures that the data is always up-to-date after you run the code.
Next, the code loops through the range on each worksheet and copies the values and formatting to the summary worksheet. Code is also included to copy the name of each worksheet to the H column in the summary worksheet. Finally, the summary worksheet is resized to fit just the inserted data.
There are other options available to you to change the areas in the worksheets that you working with. Following are some changes you can make to the previous code.
-
To copy all cells with data on the source worksheets, use the following line of code.
Visual BasicSet CopyRng = sh.UsedRange -
To copy the current region of cell A1, use the following line of code. The current region is a range bounded by any combination of blank rows and blank columns.
Visual BasicSet CopyRng = sh.Range("A1").CurrentRegion
-
To copy a complete row, use the following line of code.
Visual BasicSet CopyRng = sh.Rows("1")
-
To copy a subset of rows, use the following line of code. This example copies rows 1 through 8.
Visual BasicSet CopyRng = sh.Rows("1:8")
-
To copy only the data without the formatting, locate the following lines in the preceding module code block.
Replace the lines with the following code.Visual BasicCopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With
Visual BasicWith CopyRng DestSh.Cells(Last + 1, "A").Resize(.Rows.Count, _ .Columns.Count).Value = .Value End With
-
To copy all values, formatting, formulas, data validation, and comments, locate the following lines in the preceding module code block.
Replace the lines with the following code.Visual BasicCopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With
Visual BasicCopyRng.Copy DestSh.Cells(Last + 1, "A") -
To copy only from worksheets with a specific name (for example, worksheets that start with the word “week”), locate the following line in the preceding module code block.
Replace the line with the following code.Visual BasicIf sh.Name <> DestSh.Name Then
Visual BasicIf LCase(Left(sh.Name, 4)) = "week" Then
-
To copy only from the visible worksheets in your workbook, locate the following line in the preceding module code block.
Replace the line with the following code.Visual BasicIf sh.Name <> DestSh.Name Then
Visual BasicIf sh.Name <> DestSh.Name And sh.Visible = True Then
-
To copy data from the worksheets into an array, locate the following line in the preceding module code block.
Replace the line with the following code.Visual BasicFor Each sh In ActiveWorkbook.Worksheets
And delete the following two lines.Visual BasicFor Each sh In ActiveWorkbook.Sheets(Array("Sheet1", "Sheet3"))
Visual BasicIf sh.Name <> DestSh.Name Then End If
-
To include more worksheets than the summary worksheet, locate the following line in the preceding module code block.
Replace the line with the following code.Visual BasicIf sh.Name <> DestSh.Name Then
Visual BasicIf IsError(Application.Match(sh.Name, _ Array(DestSh.Name, "Total Sheet", "Menu Sheet"), 0)) Then
Copying All Data Except Column Headers from Multiple Worksheets
In the following steps, you copy all of the data except column headers from multiple worksheets when you copy data into the summary worksheet.
To copy data from ranges without headers from multiple worksheets
-
Type or paste the following code into the module code window.
Visual BasicSub CopyDataWithoutHeaders() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim shLast As Long Dim CopyRng As Range Dim StartRow As Long With Application .ScreenUpdating = False .EnableEvents = False End With ' Delete the summary sheet if it exists. Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True ' Add a new summary worksheet. Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "RDBMergeSheet" ' Fill in the start row. StartRow = 2 ' Loop through all worksheets and copy the data to the ' summary worksheet. For Each sh In ActiveWorkbook.Worksheets If sh.Name <> DestSh.Name Then ' Find the last row with data on the summary ' and source worksheets. Last = LastRow(DestSh) shLast = LastRow(sh) ' If source worksheet is not empty and if the last ' row >= StartRow, copy the range. If shLast > 0 And shLast >= StartRow Then 'Set the range that you want to copy Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast)) ' Test to see whether there are enough rows in the summary ' worksheet to copy all the data. If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then MsgBox "There are not enough rows in the " & _ "summary worksheet to place the data." GoTo ExitTheSub End If ' This statement copies values and formats. CopyRng.Copy With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With End If End If Next ExitTheSub: Application.Goto DestSh.Cells(1) ' AutoFit the column width in the summary sheet. DestSh.Columns.AutoFit With Application .ScreenUpdating = True .EnableEvents = True End With End Sub
-
Press Alt+Q to exit the Visual Basic Editor.
-
Press Alt+F8 to run the code.
This code copies all of the data from each worksheet except that the starting row in the source worksheets is set to the second row. This copies just the data, minus the column headers, to the summary worksheet.
Appending Data After the Last Column in the Summary Worksheet
The following procedure pastes the data from the source worksheets after the last column with data in the summary worksheet.
Note: |
|---|
| Excel 2003 has a maximum of 256 columns. Excel 2007 has a maximum of 16,384 columns. |
To copy data from multiple worksheets and append it after the last column in a summary worksheet
-
Type or paste the following code into the module code window.
Visual BasicSub AppendDataAfterLastColumn() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim CopyRng As Range With Application .ScreenUpdating = False .EnableEvents = False End With ' Delete the summary worksheet if it exists. Application.DisplayAlerts = False On Error Resume Next ActiveWorkbook.Worksheets("RDBMergeSheet").Delete On Error GoTo 0 Application.DisplayAlerts = True ' Add a worksheet with the name "RDBMergeSheet" Set DestSh = ActiveWorkbook.Worksheets.Add DestSh.Name = "RDBMergeSheet" ' Loop through all worksheets and copy the data to the ' summary worksheet. For Each sh In ActiveWorkbook.Worksheets If sh.Name <> DestSh.Name Then ' Find the last column with data on the summary ' worksheet. Last = LastCol(DestSh) ' Fill in the columns that you want to copy. Set CopyRng = sh.Range("A:A") ' Test to see whether there enough rows in the summary ' worksheet to copy all the data. If Last + CopyRng.Columns.Count > DestSh.Columns.Count Then MsgBox "There are not enough columns in " & _ "the summary worksheet." GoTo ExitTheSub End If ' This statement copies values, formats, and the column width. CopyRng.Copy With DestSh.Cells(1, Last + 1) .PasteSpecial 8 ' Column width .PasteSpecial xlPasteValues .PasteSpecial xlPasteFormats Application.CutCopyMode = False End With End If Next ExitTheSub: Application.Goto DestSh.Cells(1) With Application .ScreenUpdating = True .EnableEvents = True End With End Sub
-
Press Alt+Q to exit the Visual Basic Editor.
-
Press Alt+F8 to run the code.
This procedure determines the last column in the summary workbook that contains data and then appends the column A source data after that column. The notation A:A copies the entire column, but you can also specify a range such as A1:A10. You can use notation such as A:C to copy additional columns. To make these changes, change the following statement in the code.
Set CopyRng = sh.Range("A:A")
Conclusion
In this article, you saw several code samples that you can use to merge data from all or some worksheets into one summary worksheet. Exploring and implementing these techniques into 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 about the techniques and methods discussed in this article at the following locations.
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.
Any help is greatly appreciated.
Jess
Note: