Автоматически вставлять разрывы страниц в предпросмотр страницы

Question

У меня есть код для автоматической вставки разрывов страниц в зависимости от разделов в столбце C.

Мои разделы расположены в 4 строки.

Вот код, который иногда работал, когда разделы были в столбце B, теперь разделы находятся в столбце C, и я изменил диапазон, но он, похоже, не работает:

Dim fnd As Range, r As Range, pb As Variant
Dim PrintVersion As Worksheet

Set PrintVersion = ThisWorkbook.Sheets("Print version")

PrintVersion.Activate

   ' make sure sheet is in page break view
    PrintVersion.Parent.Windows(1).View = xlPageBreakPreview

    ' first clear any set page breaks
    On Error Resume Next
    For Each pb In PrintVersion.HPageBreaks
        pb.Delete
    Next
    On Error GoTo 0

    ' move preposed breaks to top of segement
    With PrintVersion.HPageBreaks
        For pb = 1 To .Count
            Set r = Cells(.Item(pb).Location.Row, 3)
            Set fnd = Range("C:C").Find("*", r, , , , xlPrevious)
            If Not Intersect(fnd.Offset(, -1).Resize(fnd.Offset(, 1).End(xlDown).Row - fnd.Row + 1, 4), r) Is Nothing Then
                Set .Item(pb).Location = fnd
            DoEvents
        End If
        Next
    End With

До этого у меня былоОбтекание и автоподгонка:

With PrintVersion.Range("Print_Area")

        With .Cells.Rows
            .WrapText = True
            .VerticalAlignment = xlCenter
            .EntireRow.AutoFit
        End With
End With

Результат (разрыв строки должен быть в строке 148):

Answer 1

Я предлагаю сбросить все разрывы страниц на ResetAllPageBreaks и Find в первом столбце:

Private Sub BreakPages()
    Dim fnd As Range, r As Range, pb As Variant
    Dim PrintVersion As Worksheet

    Set PrintVersion = ThisWorkbook.Sheets("Print version")

    PrintVersion.Activate

    ' make sure sheet is in page break view
    PrintVersion.Parent.Windows(1).View = xlPageBreakPreview

    ' first clear any set page breaks
    PrintVersion.ResetAllPageBreaks

    ' move preposed breaks to top of segement
    With PrintVersion.HPageBreaks
        For pb = 1 To .Count
            ' check if first column is empty
            Set r = PrintVersion.Cells(.Item(pb).Location.Row, 1)
            If r.value = "" Then
                ' find previous cell in column 1 which is not empty
                Set fnd = PrintVersion.Columns(1).Find("*", r, , , , xlPrevious)
                ' set page break 1 row above it
                Set .Item(pb).Location = fnd.Offset(-1, 0)
                DoEvents
            End If
        Next
    End With
End Sub