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 (https://io-games.onl/)


Very helpful comment! Thanks a lot for your sharing