Consolidating Data from Multiple Worksheets into a Summary Worksheet in Excel

Article
05/23/2014

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.

Sub 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.
```
Set 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.
```
Set CopyRng = sh.Range("A1").CurrentRegion
```
To copy a complete row, use the following line of code.
```
Set CopyRng = sh.Rows("1") 
```
To copy a subset of rows, use the following line of code. This example copies rows 1 through 8.
```
Set CopyRng = sh.Rows("1:8") 
```

To copy only the data without the formatting, locate the following lines in the preceding module code block.

CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
End With

Replace the lines with the following code.

With 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.

CopyRng.Copy
With DestSh.Cells(Last + 1, "A")
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
End With

Replace the lines with the following code.

CopyRng.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.
```
If sh.Name <> DestSh.Name Then
```
Replace the line with the following code.
```
If 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.
```
If sh.Name <> DestSh.Name Then
```
Replace the line with the following code.
```
If 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.
```
For Each sh In ActiveWorkbook.Worksheets
```
Replace the line with the following code.
```
For Each sh In ActiveWorkbook.Sheets(Array("Sheet1", "Sheet3"))
```
And delete the following two lines.
```
If 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.
```
If sh.Name <> DestSh.Name Then
```
Replace the line with the following code.
```
If 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.

Sub 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.

Sub 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.

Consolidating Data from Multiple Worksheets into a Summary Worksheet in Excel

Overview

To add functions that are common to all samples

Copying a Range from Multiple Worksheets

To copy data from all rows in multiple worksheets

Copying All Data Except Column Headers from Multiple Worksheets

To copy data from ranges without headers from multiple worksheets

Appending Data After the Last Column in the Summary Worksheet

To copy data from multiple worksheets and append it after the last column in a summary worksheet

Conclusion

Additional Resources

About the Authors

Additional resources