Want code to run on all sheets except one, but it is only running on active sheet.

[Huli17]

Hello VBA gurus!
I am pretty new to VBA and I am in need of help with a code in VBA that I want to be executed on all sheets in the workbook except the sheet called "Total". I further want the results from each sheet to be "printed" in the "Total" sheet. Right now, the code is only running on the active sheet, as well as it is printing the same value into all of the cells in the "Total" sheet. The different sheets have different amounts of values, and I want to use the code in several workbooks, and therefore I do not know the name of all the sheets except the "Total" sheet.

I would appreciate any help to make my code run properly, thank you in advance!
The code so far looks like this:

Sub MaxMinAverage()
    Dim vArr As Variant
   
    Dim maximum As Double
    Dim minimum As Double
    Dim average As Double
   
    Dim ws As Worksheet
    Dim WS_Count As Integer
    Dim i As Integer
    Dim j As Integer
   
   WS_Count = ActiveWorkbook.Worksheets.Count
 
    'Sort to be values under 1h but over 0 min, for each workbook except "Total"
   For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Total" Then GoTo xSkip
Range("$A$1:$K$2952").AutoFilter Field:=9, Criteria1:=Array( _
        "00:01", "00:02", "00:03", "00:04", "00:05", "00:06", "00:07", "00:08", "00:09" _
        , "00:10", "00:11", "00:12", "00:13", "00:14", "00:15", "00:16", "00:17", "00:18", _
        "00:19", "00:20", "00:21", "00:22", "00:23", "00:24", "00:25", "00:26", "00:27", "00:28", "00:29", "00:30", "00:31", "00:32" _
        , "00:33", "00:34", "00:35", "00:36", "00:37", "00:38", "00:39", "00:40", "00:41", "00:42", "00:43", "00:44", "00:45", "00:46", "00:47", "00:48", "00:49", "00:50", "00:51", "00:52", "00:53", "00:54", "00:55", "00:56", "00:57", "00:58", "00:59", "01:00"), Operator:=xlFilterValues
 
'JANUARY
    Range("$A$1:$K$5000").AutoFilter Field:=5, Operator:=xlFilterValues, Criteria2:=Array(1, "1/01/2017")
    'Use only the sorted lines in column I
    On Error Resume Next 'If there are no values
    vArr = Range("I2:I5000").SpecialCells(xlCellTypeVisible).Value
        If Err > 0 Then
            Sheets("Total").Select 'Select the total sheet and write values
            For j = 1 To WS_Count
                Cells(j + 3, 2) = 0
                Cells(j + 3, 3) = 0
                Cells(j + 3, 4) = 0
            Next
        Else
        'Find maximum, minimum and average
            maximum = Application.WorksheetFunction.Max(vArr)
            minimum = Application.WorksheetFunction.Min(vArr)
            average = Application.WorksheetFunction.average(vArr)
       
        Sheets("Total").Select 'Select the total sheet and write the values
            For j = 1 To WS_Count
                Cells(j + 3, 2) = maximum
                Cells(j + 3, 3) = minimum
                Cells(j + 3, 4) = average
            Next
        End If
 
'Worksheetname in column A
      Cells(j + 3, 1) = ws.Name
     
        
xSkip:
Next
 
End Sub

[xladept]

Change:

If ws.Name <> "Total" Then GoTo xSkip

To

If ws.Name = "Total" Then GoTo xSkip

[Huli17]

Thank you for replying, but I have tried that - and unfortunately it did not work

[xladept]

Maybe:

Sub MaxMinAverage()
    Dim vArr As Variant
   
    Dim maximum As Double
    Dim minimum As Double
    Dim average As Double
   
    Dim ws As Worksheet
    Dim WS_Count As Integer
    Dim i As Long
    Dim j As Long
   
   WS_Count = ThisWorkbook.Worksheets.Count
 
    'Sort to be values under 1h but over 0 min, for each workbook except "Total"
   For Each ws In ThisWorkbook.Worksheets
    If ws.Name = "Total" Then GoTo xSkip
Range("$A$1:$K$2952").AutoFilter Field:=9, Criteria1:="<= 1.00"
'JANUARY
    Range("$A$1:$K$5000").AutoFilter Field:=5, Operator:=xlFilterValues, Criteria2:=Array(1, "1/01/2017")
    'Use only the sorted lines in column I
    On Error Resume Next 'If there are no values
    vArr = Range("I2:I5000").SpecialCells(xlCellTypeVisible).Value
        If Err > 0 Then
            With Sheets("Total")
            j=j+1
                .Cells(j + 3, 2) = 0
                .Cells(j + 3, 3) = 0
                .Cells(j + 3, 4) = 0
                .Cells(j + 3, 1) = ws.Name
        End With
        Else
        'Find maximum, minimum and average
            maximum = Application.WorksheetFunction.Max(vArr)
            minimum = Application.WorksheetFunction.Min(vArr)
            average = Application.WorksheetFunction.average(vArr)
       
        With Sheets("Total") 'Write the values on the total sheet
                    j = j + 1
                .Cells(j + 3, 2) = maximum
                .Cells(j + 3, 3) = minimum
                .Cells(j + 3, 4) = average
            'Worksheetname in column A
            .Cells(j + 3, 1) = ws.Name
        End With   
        End If
 

     
        
xSkip:
Next
 
End Sub

[Huli17]

Thank you xladept, but the code is still not working - it keeps implementing the filters on the active sheet (also the "Total" sheet).

[mehmetcik]

Sub MaxMinAverage()
    Dim vArr As Variant
   
    Dim maximum As Double
    Dim minimum As Double
    Dim average As Double
   
    Dim ws As Worksheet
    Dim WS_Count As Integer
    Dim i As Integer
    Dim j As Integer
   
WS_Count = ActiveWorkbook.Worksheets.Count
MyArray = Array(0, 0, 0, 0)

Pos = 2
    'Sort to be values under 1h but over 0 min, for each workbook except "Total"
    
   For Each ws In ThisWorkbook.Worksheets
    If ws.Name = "Total" Then GoTo xSkip
Range("$A$1:$K$2952").AutoFilter Field:=9, Criteria1:=Array( _
        "00:01", "00:02", "00:03", "00:04", "00:05", "00:06", "00:07", "00:08", "00:09" _
        , "00:10", "00:11", "00:12", "00:13", "00:14", "00:15", "00:16", "00:17", "00:18", _
        "00:19", "00:20", "00:21", "00:22", "00:23", "00:24", "00:25", "00:26", "00:27", "00:28", "00:29", "00:30", "00:31", "00:32" _
        , "00:33", "00:34", "00:35", "00:36", "00:37", "00:38", "00:39", "00:40", "00:41", "00:42", "00:43", "00:44", "00:45", "00:46", "00:47", "00:48", "00:49", "00:50", "00:51", "00:52", "00:53", "00:54", "00:55", "00:56", "00:57", "00:58", "00:59", "01:00"), Operator:=xlFilterValues
 
'JANUARY
    Range("$A$1:$K$5000").AutoFilter Field:=5, Operator:=xlFilterValues, Criteria2:=Array(1, "1/01/2017")
    'Use only the sorted lines in column I
    On Error Resume Next 'If there are no values
    vArr = Range("I2:I5000").SpecialCells(xlCellTypeVisible).Value
        If Err > 0 Then
            
            Sheets("Total").Cells(Pos, 1).Value = ws.Name
            Sheets("Total").Range(Cells(Pos, 2), Cells(Pos, 4)).Value = 0
            
        Else
        
        'Find maximum, minimum and average
            MyArray(0) = ws.Name
            MyArray(1) = Application.WorksheetFunction.Max(vArr)
            MyArray(2) = Application.WorksheetFunction.Min(vArr)
            MyArray(3) = Application.WorksheetFunction.average(vArr)
       
        Sheets("Total").Range(Cells(Pos, 1), Cells(Pos, 4)).Value = MyArray

        End If
 
xSkip:
Next
 
End Sub

[Huli17]

Thank you for your suggestion mehmetcik, but it does not seem to work.. It is as all the other codes implementing the code on the active sheet, and not all of the sheets in the workbook except the "total" sheet.