Macro Loop Help!! - Code to Insert Totals into Each Sheet within Workbook - Excel 2013

[magnum5az]

Hello all, I am working on a piece of code that currently works fine if you trigger the code sheet by sheet manually, but when I add a loop code it keeps entering the subtotals in the same sheet over and over again? Any help is appreciated!

Sub forEachWs2()

    
    Dim ws As Worksheet
    
    
    For Each ws In ActiveWorkbook.Worksheets
    
      
        Call InsertSUBTOTAL
    
    
    Next ws

End Sub
Sub InsertSUBTOTAL()

Dim LR As Long
Dim ws As Worksheet
Set subs = Range("Grandtotal")
LR = ActiveSheet.Range("J" & Rows.Count).End(xlUp).Row

subs.Copy

ActiveSheet.Range("A" & LR + 1).Select
 
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False

Range("H" & LR + 1).Formula = "=SUM(H7:H" & LR & ")"
Range("I" & LR + 1).Formula = "=SUM(I7:I" & LR & ")"
Range("J" & LR + 1).Formula = "=SUM(J7:J" & LR & ")"
Range("K" & LR + 1).Formula = "=SUM(K7:K" & LR & ")"
Range("M" & LR + 1).Formula = "=SUM(M7:M" & LR & ")"
Range("N" & LR + 1).Formula = "=SUM(N7:N" & LR & ")"
Range("P" & LR + 1).Formula = "=SUM(P7:P" & LR & ")"

Columns.AutoFit
            Columns("L").ColumnWidth = 1.57
            Columns("A").ColumnWidth = 5.29
            Application.CutCopyMode = False
          
              
End Sub

 

[CalcSux78]

Your first sub loops through each of the worksheets, but never actually changes the activesheet.

Sub InsertSUBTOTAL()

Dim subs As Range
Dim LR As Long
Dim ws As Worksheet


Set subs = Range("Grandtotal")
For Each ws In ActiveWorkbook.Worksheets
    With ws
        LR = .Range("J" & Rows.Count).End(xlUp).Row
        subs.Copy .Range("A" & LR + 1)
        .Range("H" & LR + 1).Formula = "=SUM(H7:H" & LR & ")"
        .Range("I" & LR + 1).Formula = "=SUM(I7:I" & LR & ")"
        .Range("J" & LR + 1).Formula = "=SUM(J7:J" & LR & ")"
        .Range("K" & LR + 1).Formula = "=SUM(K7:K" & LR & ")"
        .Range("M" & LR + 1).Formula = "=SUM(M7:M" & LR & ")"
        .Range("N" & LR + 1).Formula = "=SUM(N7:N" & LR & ")"
        .Range("P" & LR + 1).Formula = "=SUM(P7:P" & LR & ")"
        .Columns.AutoFit
        .Columns("L").ColumnWidth = 1.57
        .Columns("A").ColumnWidth = 5.29
        Application.CutCopyMode = False
    End With
Next ws
              
End Sub

 

[magnum5az]

Your revision worked flawlessly! thank you for all your help!

Your first sub loops through each of the worksheets, but never actually changes the activesheet.

Sub InsertSUBTOTAL()

Dim subs As Range
Dim LR As Long
Dim ws As Worksheet


Set subs = Range("Grandtotal")
For Each ws In ActiveWorkbook.Worksheets
    With ws
        LR = .Range("J" & Rows.Count).End(xlUp).Row
        subs.Copy .Range("A" & LR + 1)
        .Range("H" & LR + 1).Formula = "=SUM(H7:H" & LR & ")"
        .Range("I" & LR + 1).Formula = "=SUM(I7:I" & LR & ")"
        .Range("J" & LR + 1).Formula = "=SUM(J7:J" & LR & ")"
        .Range("K" & LR + 1).Formula = "=SUM(K7:K" & LR & ")"
        .Range("M" & LR + 1).Formula = "=SUM(M7:M" & LR & ")"
        .Range("N" & LR + 1).Formula = "=SUM(N7:N" & LR & ")"
        .Range("P" & LR + 1).Formula = "=SUM(P7:P" & LR & ")"
        .Columns.AutoFit
        .Columns("L").ColumnWidth = 1.57
        .Columns("A").ColumnWidth = 5.29
        Application.CutCopyMode = False
    End With
Next ws
              
End Sub