# Thread: Average value

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
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```

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

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•