Question : Adding Loop through certain worksheets to Sub - VBA

Experts,

I have a two step Sub (see below). I am trying to set this to upon execution run on the following worksheets only:

ALL Sales
New Sales
Old Sales

I am wondering if a loop would be the best way to do this.

I would like the “main macro” that is seen in the “alt+F8” box to be “SetupToPrint”. So would the action of the “loop” be within SetupToPrint sub or be a Private Sub before SetPrintAreaToPivotTable, thus giving me 3 Private Subs?

         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:

           
           
          Sub SetupToPrint()
    Call SetPrintAreaToPivotTable
    Call SetPageBreakToXNumberOfRows

End Sub

Private Sub SetPrintAreaToPivotTable()

    With ActiveSheet
        lPTcells = .PivotTables("PivotTable1").DataBodyRange.Cells.Count
        Set rngTopLeft = .PivotTables("PivotTable1").RowRange.Cells(1)
        Set rngBotRight = .PivotTables("PivotTable1").DataBodyRange.Cells(lPTcells)
        strPTAddress = rngTopLeft.Address & ":" & rngBotRight.Address 'strPT address don't exist!
        .PageSetup.PrintArea = strAddress
    End With

End Sub

Private Sub SetPageBreakToXNumberOfRows()

    Dim Lastrow As Long
        Dim Row_Index As Long
        Dim RW As Long
    
        'How many rows do you want between each page break
        RW = 48
        
        With ActiveSheet
            'Remove all PageBreaks
            .ResetAllPageBreaks
            
            'Search for the last row with data in Column D
            Lastrow = .Cells(Rows.Count, "D").End(xlUp).Row
            
            For Row_Index = RW + 2 To Lastrow Step RW
                .HPageBreaks.Add Before:=.Cells(Row_Index, 1)
            Next
    End With

End Sub

           
         

Answer : Adding Loop through certain worksheets to Sub - VBA

Try this

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:

           
           
             Sub Main()
SetupToPrint "ALL Sales"
SetupToPrint "New Sales"
SetupToPrint "Old Sales"
End Sub

Private Sub SetupToPrint(sh As String)
    
    Sheets(sh).Activate
    Call SetPrintAreaToPivotTable
    Call SetPageBreakToXNumberOfRows

End Sub

Private Sub SetPrintAreaToPivotTable()

    With ActiveSheet
        lPTcells = .PivotTables("PivotTable1").DataBodyRange.Cells.Count
        Set rngTopLeft = .PivotTables("PivotTable1").RowRange.Cells(1)
        Set rngBotRight = .PivotTables("PivotTable1").DataBodyRange.Cells(lPTcells)
        strPTAddress = rngTopLeft.Address & ":" & rngBotRight.Address 'strPT address don't exist!
        .PageSetup.PrintArea = strAddress
    End With

End Sub

Private Sub SetPageBreakToXNumberOfRows()

    Dim Lastrow As Long
        Dim Row_Index As Long
        Dim RW As Long
    
        'How many rows do you want between each page break
        RW = 48
        
        With ActiveSheet
            'Remove all PageBreaks
            .ResetAllPageBreaks
            
            'Search for the last row with data in Column D
            Lastrow = .Cells(Rows.Count, "D").End(xlUp).Row
            
            For Row_Index = RW + 2 To Lastrow Step RW
                .HPageBreaks.Add Before:=.Cells(Row_Index, 1)
            Next
    End With

End Sub
           
         