Как я могу вставить ленту под разрыв страницы каждый раз?

Question

Смысл в том, чтобы распечатать страницу в формате PDF для нашего еженедельного расписания. В столбце C указана дата начала каждого задания, и мне нужна лента, занимающая всю строку, чтобы обрабатывать каждый день недели в расписании. У меня есть Do While Loop, который проверяет столбец C и добавляет ленту для каждой новой даты, но так как есть несколько страниц, мне также нужно, чтобы лента отображалась под каждым разрывом страницы.

Проблема, с которой я сталкиваюсь, заключается в том, что лента не всегда вставляется под разрыв страницы, а иногда над ним. Я нашел With Loop, который корректно обрабатывает разрывы страниц каждый раз, но я не знаю, как заставить его работать с моим Do While Loop. По сути, я могу добавить ленту дня недели только под разрыв страницы на НАШЕ раз, когда меняется дата недели.

Sub forEachDayOfWeek()

    Range("A4").Formula = "=TEXT(C5,""dddd"")"
    Range("E6").Select

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Do While ActiveCell.Offset(-1, 0) <> "" And ActiveCell.Offset(0, -1) <> ""
   If ActiveCell.Value = 1 Then
        ActiveCell.Offset(2, 0).Select
   ElseIf ActiveCell.EntireRow.PageBreak <> xlPageBreakNone Then
      Rows("4:4").Copy
      Selection.EntireRow.Insert Shift:=xlDown
      ActiveCell.Offset(2, 0).Select
    ElseIf ActiveCell.Value = ActiveCell.Offset(-1, -2) Then
        ActiveCell.Offset(1, 0).Select
    ElseIf ActiveCell.Value = ActiveCell.Offset(-1, 0) Then
        ActiveCell.Offset(1, 0).Select
    ElseIf ActiveCell.Value > ActiveCell(-1, 0) Then
        Rows("4:4").Copy
        Selection.EntireRow.Insert Shift:=xlDown
        ActiveCell.Offset(2, 0).Select
    End If
Loop

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub


Sub forEachPageBreak()

Dim ws As Worksheet
Dim PgBreak As HPageBreak

Set ws = ActiveSheet

With ws
    If .HPageBreaks.Count > 0 Then
        For Each PgBreak In .HPageBreaks
            Rows("4:4").Copy
            PgBreak.Location.Insert
        Next
    Else
        MsgBox "No data in sheets"
    End If
End With

End Sub

На картинке я отредактировал некоторую информацию, но вы можете видеть список того, о чем я говорю. Вторник выше разрыва страницы. Вот изображение результатов