VBA Keeps Looping Through One Sheet Instead Of All

[Worker8ee]

I have no idea what's going on, this code is looping through the same sheet for as many times as there are sheets in this workbook, there are 25 sheets and it is supposed to loop through all 25 of them but it is looping through the sheet (I have open when I run the code) 25 times, I have tried to figure this out for a while and am stumped, please excuse my dim names and I am not worried about any unnecessarily long code, I just need this darn thing to work asap:

Sub AddVaryingSubtotalsForEachSht()
'
' Macro2 Macro
'
    Dim sht As Worksheet
    
    
   For Each sht In ActiveWorkbook.Worksheets
   With sht
    
    Dim LastRow As Long
    Dim LastJoe As Long
    Dim LastPoe As Long
    Dim LastDoe As Long
    Dim LastSamurai As Long
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row + 2
    LastJoe = Range("A" & Rows.Count).End(xlUp).Row + 4
    LastPoe = Range("A" & Rows.Count).End(xlUp).Row + 5
    LastDoe = Range("A" & Rows.Count).End(xlUp).Row + 6
    LastSamurai = Range("E" & Rows.Count).End(xlUp).Row
    
    Range("C" & LastRow).FormulaR1C1 = "TOTALS"
    Range("C" & LastRow).Select
    Selection.Font.Bold = True
    Range("C" & LastJoe).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65280
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
        Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "WOW"
    Range("C" & LastPoe).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 52479
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 52479
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "OUT OF STOCK"
    Range("C" & LastDoe).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "NO SALES"
    Range("C" & LastDoe).Select
    Selection.Font.Bold = True
    With Selection.Font
        .ColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
   
    
Dim LastKo As Long
LastKo = Range("A60000").End(xlUp).Row
Range("E" & LastKo + 2).Formula = "=Sum(E6:E" & LastKo & ")"
    
    Range("E" & LastRow).Select
    Selection.Font.Bold = True
    Selection.Copy
    Range("G" & LastRow).Select
    Selection.Font.Bold = True
    Range("E" & LastRow).Select
    Selection.Copy
    Range("G" & LastRow).Select
    ActiveSheet.Paste
    Range("I" & LastRow).Select
    Selection.Font.Bold = True
        Range("E" & LastRow).Select
    Selection.Copy
    Range("I" & LastRow).Select
    ActiveSheet.Paste
    Range("K" & LastRow).Select
    Selection.Font.Bold = True
        Range("E" & LastRow).Select
    Selection.Copy
    Range("K" & LastRow).Select
    ActiveSheet.Paste
    Range("L" & LastRow).Select
    Selection.Font.Bold = True
        Range("E" & LastRow).Select
    Selection.Copy
    Range("L" & LastRow).Select
    ActiveSheet.Paste
    Range("N" & LastRow).Select
    Selection.Font.Bold = True
        Range("E" & LastRow).Select
    Selection.Copy
    Range("N" & LastRow).Select
    ActiveSheet.Paste
    Range("O" & LastRow).Select
    Selection.Font.Bold = True
        Range("E" & LastRow).Select
    Selection.Copy
    Range("O" & LastRow).Select
    ActiveSheet.Paste
    Range("Q" & LastRow).Select
    Selection.Font.Bold = True
        Range("E" & LastRow).Select
    Selection.Copy
    Range("Q" & LastRow).Select
    ActiveSheet.Paste
    Range("R" & LastRow).Select
    Selection.Font.Bold = True
        Range("E" & LastRow).Select
    Selection.Copy
    Range("R" & LastRow).Select
    ActiveSheet.Paste
    Range("T" & LastRow).Select
    Selection.Font.Bold = True
        Range("E" & LastRow).Select
    Selection.Copy
    Range("T" & LastRow).Select
    ActiveSheet.Paste
    Range("U" & LastRow).Select
    Selection.Font.Bold = True
        Range("E" & LastRow).Select
    Selection.Copy
    Range("U" & LastRow).Select
    ActiveSheet.Paste
    Range("W" & LastRow).Select
    Selection.Font.Bold = True
        Range("E" & LastRow).Select
    Selection.Copy
    Range("W" & LastRow).Select
    ActiveSheet.Paste
    Range("C" & LastRow, "W" & LastRow).Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    Intersect(Rows(LastRow), Range("G:G,K:K,N:N,Q:Q,T:T,W:W")).NumberFormat = "$#,##0.00"
    Range(Replace("F#,H#,J#,L#,N#,P#", "#", LastRow)).NumberFormat = "$#,##0.00"
    
End With
Next sht
End Sub

 

[Michael M]

Try adding

For Each sht In ActiveWorkbook.Worksheets
[color=red]sht.activate[/color]
With sht

 

[Worker8ee]

I am quite embarrassed even with my anonymity, Michael M thank you for being so kind as to answer so quickly. That is what I was missing, I promise I will master this VBA stuff and will pay it forward on these message boards!

 

[Michael M]

you could also speed things up by getting rid of Select.Selection lines

This

Range("G" & LastRow).Select
Selection.Font.Bold = True
Range("E" & LastRow).Select
Selection.Copy
Range("G" & LastRow).Select
ActiveSheet.Paste

Could be

Range("G" & LastRow).Font.Bold = True
Range("E" & LastRow).Copy Range("G" & LastRow)

 

[Fluff]

@Worker8ee
When posting code please use code tags, the # icon in the reply window.