Summary sheet to refer to cell on multiple sheets (always same column, but row# can vary)

Hi Everybody,

I found some code from Ron de Bruin that creates a Summary sheet form all worksheets. Of course, it works perfectly, but I want to modify it slightly to meet my needs. In his example code, he has it referring to:

 For Each myCell In Sh.Range("A1,D5:E5,Z10")

I tried modifying to point to a different range, but it throws an error. Here is the modification I made:

 For Each myCell In Sh.Range("M2").End(xlDown).Offset(2, 0)

My goal with the above code is to refer to the cell two rows below the last cell with continuous data in column M on every sheet in the workbook.

Here is the entire sample code provided by Ron without modification:

 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

All help is greatly appreciated!

Carlos

i think this is all you need:

Sub SjonR()
For Each sh In Sheets
    sh.Cells(Rows.Count, "M").End(xlUp).Offset(2) = "test"
Next
End Sub

the for each myCell loop is not usefull when refering to only one cell in a sheet.

Hi SjonR, and thank you for your reply, but it does not achieve what I am trying to do.

I have several project sheets with data (about 30 or so sheets). The code that I found on Ron de Bruin's site creates a summary sheet for the data in all of the other project sheets. This is perfect. Next, I want to retrieve data from some cells in all of the project sheets to present on the new summary sheet. In Ron's sample code, he points to ("A1,D5:E5,Z10"), and it works perfectly. Unfortunately, those cells are not the ones that I want to reference on my project sheets. Instead, I want the code to point to the cell two rows below the last cell with continuous data in column M on every project sheet in the workbook.

Each project sheet has various values in column M. So, it might look like: Header = Backlog, cell M2 contains 4, cell M3 contains 5, and then M4 is blank, and M5 contains the sum of the values in M2 and M3 which = 9. The number of rows varies from sheet to sheet, so the sum of values in column M on the next sheet might sit in cell M22, and the sheet after that, the sum might sit in cell M18.

I want the code to find the sum of the values for column M on each sheet, and return that value to my summary sheet.

An example file Will help us a lot.

Sorry for the delayed response ... I cannot reply to posts on this forum (even though I can create new posts!)

I played around with the code some more, and I was able to make it work. Here it is:

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
    Dim LR As Long
    Dim src As Range
    Dim ws As Worksheet
    
    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"
    Newsh.Range("B1:H1").Value = Array("Study Number", "Unit Tracker Owner", "Group Lead", "Sponsor", "Backlog Remaining", "Forecast Cost", "Cost Exceeding Backlog", "Cost Exceeding Contract")

    '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 = 2
            RwNum = RwNum + 1
            'Copy the sheet name in the A column
            Newsh.Cells(RwNum, 1).Value = Sh.Name

            For Each myCell In Sh.Range("L2").End(xlDown).Offset(2, 0) '<--Change the range
                ColNum = ColNum + 4
                Newsh.Cells(RwNum, ColNum).Formula = _
                "='" & Sh.Name & "'!" & myCell.Address(False, False)
            Next myCell
            
            For Each myCell In Sh.Range("P2").End(xlDown).Offset(2, 0) '<--Change the range
                ColNum = ColNum + 1
                Newsh.Cells(RwNum, ColNum).Formula = _
                "='" & Sh.Name & "'!" & myCell.Address(False, False)
            Next myCell
            
            For Each myCell In Sh.Range("Q2").End(xlDown).Offset(2, 0) '<--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
    
    'Format study numbers to have leading zeros
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:A" & LR).NumberFormat = "00000000"
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:A" & LR).HorizontalAlignment = xlHAlignLeft

Set src = Range("B1").CurrentRegion
Set ws = ActiveSheet

ws.ListObjects.Add(SourceType:=xlSrcRange, Source:=src, _
xlListObjectHasHeaders:=xlYes, tablestyleName:="TableStyleMedium28").Name = "Sales_Table"
ws.Range("B:B").EntireColumn.Hidden = False
ws.Range("A:A").EntireColumn.Hidden = True
  
ws.Range("B2") = "=INDIRECT(""'"" & TEXT(A2,""00000000"") &""'!A2"")"
                
End Sub