Create a summary worksheet from all worksheets (with formulas)

Create a summary worksheet from all worksheets (with formulas)

Ron de Bruin (last update 14-June-2009)
Go back to the Excel tips page

This macro will add a worksheet to your workbook with the name “Summary-Sheet”.
It will use one row on that sheet for every visible worksheet in your workbook.
For each cell in the example Range "A1,D5:E5,Z10" it will add a link on that row,
starting in column “B” (It will copy the sheet name in column “A”).

Sub Summary_All_Worksheets_With_Formulas()
    Dim Sh As Worksheet
    Dim Newsh As Worksheet
    Dim myCell As Range
    Dim ColNum As Integer
    Dim RwNum As Long
    Dim Basebook As Workbook

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'Delete the sheet "Summary-Sheet" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets("Summary-Sheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add a worksheet with the name "Summary-Sheet"
    Set Basebook = ThisWorkbook
    Set Newsh = Basebook.Worksheets.Add
    Newsh.Name = "Summary-Sheet"

    'The links to the first sheet will start in row 2
    RwNum = 1

    For Each Sh In Basebook.Worksheets
        If Sh.Name <> Newsh.Name And Sh.Visible Then
            ColNum = 1
            RwNum = RwNum + 1
            'Copy the sheet name in the A column
            Newsh.Cells(RwNum, 1).Value = Sh.Name

            For Each myCell In Sh.Range("A1,D5:E5,Z10")    '<--Change the range
                ColNum = ColNum + 1
                Newsh.Cells(RwNum, ColNum).Formula = _
                "='" & Sh.Name & "'!" & myCell.Address(False, False)
            Next myCell

        End If
    Next Sh

    Newsh.UsedRange.Columns.AutoFit

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

Note: if you want to add headers in the first row you can use this code line after you
add and named Newsh

'Add headers
Newsh.Range("B1:E1").Value = Array("header1", "header2", "header3", "header4")

You see that there are four cells in the range and four words in the array.
Be sure that both are the the same if you add more headers.

Use a Hyperlink to the sheet in column A instead of the sheet name

Replace:

            'Copy the sheet name in the A column
            Newsh.Cells(RwNum, 1).Value = Sh.Name

With:

'Create a link to the sheet in the A column
    Newsh.Hyperlinks.Add Anchor:=Newsh.Cells(RwNum, 1), Address:="", _
                         SubAddress:="'" & Sh.Name & "'!A1", TextToDisplay:=Sh.Name

Or: If you want to use the the Hyperlink worksheet function use this this tip from
David McRitchie and Dave Peterson.

'Create a link to the sheet in the A column
    Newsh.Cells(RwNum, 1).Formula _
          = "=HYPERLINK(""#""&CELL(""address"",'" & Sh.Name & "'!A1)," _
          & """" & Sh.Name & """)"

Use a existing worksheet

Another way is to use a existing worksheet in your workbook and clear the old content in the code.
Note: I not clear row 1 in this example (maybe your header row)

Replace

'Delete the sheet "Summary-Sheet" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ThisWorkbook.Worksheets("Summary-Sheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add a worksheet with the name "Summary-Sheet"
    Set Basebook = ThisWorkbook
    Set Newsh = Basebook.Worksheets.Add
    Newsh.Name = "Summary-Sheet"

With this (change "YourSheet" to your worksheet name)

    Set Basebook = ThisWorkbook
    Set Newsh = Basebook.Worksheets("YourSheet")
    Newsh.Rows("2:" & Newsh.Rows.Count).Clear