Snasui Excel Forum

Code: Select all

Private Sub test()
    Dim LastRow As Long, l As Long, _
        rCode As Range, r As Range, sArea As String
    With ActiveSheet
        LastRow = .Range("a" & .Rows.Count).End(xlUp).Row
        Set rCode = .Range("a1:a" & LastRow).SpecialCells( _
            xlCellTypeConstants, xlTextValues)
        l = rCode.Range("a1").End(xlToRight).Column
        sArea = rCode.Range("a1").Resize( _
                LastRow - rCode.Range("a1").Row + 1, l).Address
        With .PageSetup
            .Orientation = xlLandscape
            .PrintArea = sArea
        End With
    End With
    l = 1
    For Each r In rCode
        If r.Address <> rCode.Range("a1").Address Then
            Set ActiveSheet.HPageBreaks(l).Location = r
            l = l + 1
        End If
    Next r
End Sub