1. ## Average value

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.

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

3. 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
Worksheets("Averages").Delete
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

With Worksheets("Averages")
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```

4. Originally Posted by 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
Worksheets("Averages").Delete
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

With Worksheets("Averages")
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```