Loop throught Sheets and find Average from Cells across said sheets

[adamprocter]

ActiveSheet.Unprotect
    ''Company Dashboard population script follows
Dim ws As Worksheet
Dim CountSilver As Long
Dim CountGold As Long

Dim rcMatch As Variant
Dim lLastRow As Long

Range("D3:D21").ClearContents
Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets

  With ws
   ILastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

  Select Case ws.Name
    Case "Dashboard", "Welcome"
    
    Case Else:
    'IE
      ActiveSheet.Range("D3").Value = ActiveSheet.Range("D3").Value + .Range("B6").Value
      'AE
      ActiveSheet.Range("D4").Value = ActiveSheet.Range("D4").Value + .Range("M24").Value
                
      'From that day
      rcMatch = Application.Match(CLng(Date), .Range("A1:A" & ILastRow), 0)
                
                If IsNumeric(rcMatch) Then
                'Day  Total
                    ActiveSheet.Range("D5").Value = ActiveSheet.Range("D5").Value + .Range("E" & rcMatch).Value
                   
                   'MV Total
                       ActiveSheet.Range("D6").Value = ActiveSheet.Range("D6").Value + .Range("C" & rcMatch).Value
                     
                                
                End If
              
                
      
            Select Case True
                Case InStr(1, .Name, "Silver") > 0
                        CountSilver = CountSilver + 1
                        Range("D22").Value = CountSilver
                        ActiveSheet.Range("D8").Value = ActiveSheet.Range("D8").Value + .Range("B3").Value
                       
                                               
                Case InStr(1, .Name, "Gold") > 0
                        CountGold = CountGold + 1
                        Range("D23").Value = CountGold
                        ActiveSheet.Range("D9").Value = ActiveSheet.Range("D9").Value + .Range("B3").Value
                        
                                      
                Case Else
                    Value = ""
            End Select
   
    End Select

   
  End With
Next ws

ActiveSheet.Range(Cells(2, 4), Cells(2, 4)).Locked = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True

End Sub

This is working great BUT I need to also grab a values from all sheets are not add up but find the average for all sheets named Silver or Gold

I have tried adding the follow into the Case True Silver and Gold Sections but both are wrong

ActiveSheet.Range("D14").Formula = ActiveSheet.Range("D3").Value + "=AVERAGE(".Range("B3").Value")"

ActiveSheet.Range("D14").Formula = "=AVERAGE(".Range("B3").Value")"

 

[adamprocter]

Any ideas on this one ? still stuck

 

[adamprocter]

Still stuck just bumping one final time.