Average value

[DrCaesar]

Hi, please I need help to transfer the average of all cells in all sheets to a new sheet. I have an excel file with about 30 sheets, all have about 5 columns with over 500 cells in each column. I need to find the average of each cell in each sheet. For example, the average of the cells in all sheets in B1,B2...B500, then C1,C2...C500. and so on, so that I have a single excel sheet showing all averages with the same number of columns, cells and dates.


Thank you very much for your help.

[snb]

You'd better use 1 workheet to store all data.
With a dynamic table & autofilter you can accomplish anything you want without formulae or VBA.

[Paul_Hossler]

Two ways to consider

1. Just use WS formulas, requires some updates as sheets change

2. Use VBA to create formulas

Option Explicit


Sub AveragesFormulas()
    Dim aryWorksheets() As String
    Dim i As Long
    
    Application.ScreenUpdating = False
    
    'delete old average sheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Averages").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    'remember worksheets
    ReDim aryWorksheets(1 To Worksheets.Count)
    
    For i = LBound(aryWorksheets) To UBound(aryWorksheets)
        aryWorksheets(i) = Worksheets(i).Name
    Next i
    
    'make new Averages sheet
    Worksheets.Add.Name = "Averages"


    With Worksheets("Averages")
        'headers
        Worksheets(aryWorksheets(1)).Cells(1, 1).Resize(1, 5).Copy .Cells(1, 2).Resize(1, 5)


        For i = LBound(aryWorksheets) To UBound(aryWorksheets)
            'sheet name in col A
            .Cells(i + 1, 1).Value = aryWorksheets(i)
                    
            'formula in colB
            .Cells(i + 1, 2).Formula = "=AVERAGE(" & aryWorksheets(i) & "!A:A)"
        Next i


        'copy formulas to last 4 col
        .Cells(2, 2).Resize(UBound(aryWorksheets), 1).Copy .Cells(2, 3).Resize(UBound(aryWorksheets), 4)
    End With


    Application.ScreenUpdating = True
End Sub

[cristommy]

Two ways to consider

1. Just use WS formulas, requires some updates as sheets change

2. Use VBA to create formulas

Option Explicit


Sub AveragesFormulas()
    Dim aryWorksheets() As String
    Dim i As Long
    
    Application.ScreenUpdating = False
    
    'delete old average sheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Averages").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    'remember worksheets
    ReDim aryWorksheets(1 To Worksheets.Count)
    
    For i = LBound(aryWorksheets) To UBound(aryWorksheets)
        aryWorksheets(i) = Worksheets(i).Name
    Next i
    
    'make new Averages sheet
    Worksheets.Add.Name = "Averages"


    With Worksheets("Averages")
        'headers
        Worksheets(aryWorksheets(1)).Cells(1, 1).Resize(1, 5).Copy .Cells(1, 2).Resize(1, 5)


        For i = LBound(aryWorksheets) To UBound(aryWorksheets)
            'sheet name in col A
            .Cells(i + 1, 1).Value = aryWorksheets(i)
                    
            'formula in colB
            .Cells(i + 1, 2).Formula = "=AVERAGE(" & aryWorksheets(i) & "!A:A)"
        Next i


        'copy formulas to last 4 col
        .Cells(2, 2).Resize(UBound(aryWorksheets), 1).Copy .Cells(2, 3).Resize(UBound(aryWorksheets), 4)
    End With


    Application.ScreenUpdating = True
End Sub
io games

Very helpful comment! Thanks a lot for your sharing