Print set of rows together

Sub PrettyPageBreaks()
'Sets page breaks to avoid putting the green section header at bottom of page or splitting merged cells
Dim i As Long, j As Long, n As Long, scrollRow As Long, scrollColumn As Long
Dim cel As Range, LastCell As Range, rg As Range, rg1 As Range, rgPrintArea As Range
'On Error GoTo 0
Application.EnableEvents = False
Application.ScreenUpdating = False
With ActiveSheet
    Set rg1 = ActiveCell
    scrollRow = ActiveWindow.scrollRow
    scrollColumn = ActiveWindow.scrollColumn
    Set rgPrintArea = Intersect(.Range(.PageSetup.PrintArea), .UsedRange)
    
    .ResetAllPageBreaks             'Remove all existing page breaks, Zoom & "Fit to" settings
    .PageSetup.Zoom = False         'Must turn Zoom off and restore the "Fit to" settings
    .PageSetup.FitToPagesWide = 1
    .PageSetup.FitToPagesTall = 99
    ActiveWindow.View = xlPageBreakPreview
    
        'Put manual page breaks back in where needed to avoid "breaking" two merged rows
    .DisplayAutomaticPageBreaks = True      'This statement needed to reset count of page breaks
        'Bug in Excel 97-2003 means that automatic page breaks can be found reliably only if the active cell _
            is at the end of the print area and screen updating is "on". This next statement finds that cell _
            See http://support.microsoft.com/kb/210663/en-us
    Set LastCell = rgPrintArea.Find(What:="*", After:=rgPrintArea.Cells(1, 1), LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Offset(1, 0)
    LastCell.Select
    
    If .HPageBreaks.Count > 0 Then
        Application.ScreenUpdating = False
        Do
            i = i + 1
            .HPageBreaks(i).Location.EntireRow.Select   'Selection expands to include rows of any merged cells
            j = Selection.Row
            If .Cells(j - 1, 1).Interior.ColorIndex = 35 Then     'Don't end page on green row
                .Cells(j - 1, 1).EntireRow.Select
                j = Selection.Row
                If .Cells(j - 1, 1).Interior.ColorIndex = 35 Then
                    .Cells(j - 1, 1).EntireRow.Select
                    j = Selection.Row
                End If
            End If
            LastCell.Select
            If j <> .HPageBreaks(i).Location.Row Then
                Set .HPageBreaks(i).Location = .Cells(j, 1)     'This syntax is not suggested by on-line help!
             End If
            If i >= .HPageBreaks.Count Then Exit Do
        Loop
    End If
    
    rg1.Select    'Return to the original starting point
    ActiveWindow.scrollRow = scrollRow
    ActiveWindow.scrollColumn = scrollColumn
    ActiveWindow.View = xlNormalView
    Application.ScreenUpdating = True
    
End With
Application.EnableEvents = True
'On Error GoTo 0
End Sub
                                              

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:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60: