Snasui Excel Forum

Code: Select all

Option Explicit
Sub BeforePrint()
Dim r As Range
Dim i As Integer
Application.ScreenUpdating = False
Set r = Worksheets("Page3").Range("A214")
    Do While r.Offset(i, 0) = ""
    r.Offset(i, 0).EntireRow.Hidden = True
    i = i - 1
    Loop
Worksheets("Page3").PrintOut
Worksheets("Page3").Range("A:A").EntireRow.Hidden = False
Application.ScreenUpdating = True
End Sub

Code: Select all

Sub BeforePrint()
    Dim r As Range, t As Range
    Dim i As Integer, s As Integer
    Dim j As Integer
    
    Application.ScreenUpdating = False
    Set t = Worksheets("page3").Range("a7")
    Set r = Worksheets("Page3").Range("A214")
    
    If t.Value = "" Then Exit Sub
    For j = 0 To 215 Step 19
        If t.Offset(j, 0).Value = "" Then Exit For
    Next j
    Worksheets("page3").Range(t.Offset(j, 0), r).EntireRow.Hidden = True
'        Do While r.Offset(i, 0) = ""
'            r.Offset(i, 0).EntireRow.Hidden = True
'            i = i - 1
'        Loop
    Worksheets("Page3").PrintOut
    Worksheets("Page3").Range("A:A").EntireRow.Hidden = False
    Application.ScreenUpdating = True
End Sub

Code: Select all

Sub test0()
    Dim r As Range, i As Integer
 
    For i = 0 To 255 Step 20
        
        With Worksheets("page3")
            If .Range("a7").Offset(i, 0).Value <> "" Then
                .Range("a7").Offset(i, 0).Resize(20, 25).Copy _
                    Worksheets("Sheet1").Range("a7")
            Else
                Exit Sub
            End If
        End With

        With Worksheets("Sheet1")
            If .Range("a26").Value = "" Then
                .PageSetup.PrintArea = .Range("a1:y27").Address
            Else
                .PageSetup.PrintArea = .Range("a1:y27").Address
            End If
            With .PageSetup
                .FitToPagesWide = 1
                .FitToPagesTall = 1
            End With
            Worksheets("Sheet1").PrintOut
        End With
    Next i
End Sub

Code: Select all

'Other code
            If .Range("a26").Value = "" Then
                .PageSetup.PrintArea = .Range("a1:y27").Address
            Else
                .PageSetup.PrintArea = .Range("a1:y26").Address
            End If
'Other code

Code: Select all

Sub test0()
    Dim r As Range, i As Integer
     For i = 0 To 215 Step 20
                With Worksheets("page3")
            If .Range("a7").Offset(i, 0).Value <> "" Then
                .Range("a7").Offset(i, 0).Resize(20, 26).Copy _
                    Worksheets("Sheet1").Range("a7")
            Else
                Exit Sub
            End If
        End With
        With Worksheets("Sheet1")
            If .Range("a26").Value = "" Then
                .PageSetup.PrintArea = .Range("a1:y27").Address
            Else
                .PageSetup.PrintArea = .Range("a1:y26").Address
            End If
            With .PageSetup
                .FitToPagesWide = 1
                .FitToPagesTall = 1
            End With
            Worksheets("Sheet1").PrintOut
        End With
    Next i
End Sub

Code: Select all

Sub test0()
    Dim r As Range, i As Integer
 
    For i = 0 To 255 Step 20
        
        With Worksheets("page3")
            If .Range("a7").Offset(i, 0).Value <> "" Then
                .Range("a7").Offset(i, 0).Resize(20, 25).Copy _
                    Worksheets("Sheet1").Range("a7")
                
            If .Range("a26").Value = "" Then
                .PageSetup.PrintArea = .Range("a1:y27").Address
            Else
                .PageSetup.PrintArea = .Range("a1:y26").Address
            End If
                    
            Else
                Exit Sub
            End If
        End With

        With Worksheets("Sheet1")
            If .Range("a26").Value = "" Then
                .PageSetup.PrintArea = .Range("a1:y27").Address
            Else
                .PageSetup.PrintArea = .Range("a1:y27").Address
            End If
            With .PageSetup
                .FitToPagesWide = 1
                .FitToPagesTall = 1
            End With
            Worksheets("Sheet1").PrintOut
        End With
    Next i
End Sub

Code: Select all

Sub test0()
    Dim r As Range, i As Integer
    Dim j As Integer, k As Integer
 
    With Worksheets("page3")
        j = .Range("a7", .Range("a" & .Rows.Count).End(xlUp)).Rows.Count
    End With
    k = 0
    For i = 0 To 215 Step 20
        
        With Worksheets("page3")
            If .Range("a7").Offset(i, 0).Value <> "" Then
                .Range("a7").Offset(i, 0).Resize(20, 26).Copy _
                    Worksheets("Sheet1").Range("a7")
            Else
                Exit Sub
            End If
        End With

        With Worksheets("Sheet1")
            k = k + .Range("a7", .Range("a" & .Rows.Count).End(xlUp)).Rows.Count
            If .Range("a26").Value = "" Or k = j Then
                .PageSetup.PrintArea = .Range("a1:y27").Address
            Else
                .PageSetup.PrintArea = .Range("a1:y26").Address
            End If
            With .PageSetup
                .FitToPagesWide = 1
                .FitToPagesTall = 1
            End With
            Worksheets("Sheet1").PrintOut
        End With
    Next i
End Sub