Share via


Consolidating Data from Multiple Worksheets into a Summary Worksheet in Excel

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

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

  1. 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
    
  2. Press Alt+Q to exit the Visual Basic Editor.

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

  1. 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
    
  2. Press Alt+Q to exit the Visual Basic Editor.

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

NoteNote

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

  1. 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
    
  2. Press Alt+Q to exit the Visual Basic Editor.

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