danne sideskift med vba

Jeg har en kodestump der indsætter nogle manuelle sideskift.
Den virker som den skal, men der er alligevel nogle gange at jeg gerne vil have den til at gøre det lidt anderledes.

Koden kigger efter om der står noget i kollonne H, hvis der gør det laver den sideskift lige over den linje som har noget stående i kol H.

Her kommer det nye:
Det sker at der står noget i kolonne H i to linjer lige over hinanden. Hvis der gør det skal den sætte sideskiftet 1 linje over den ØVERSTE linje der har noget i kolonne H.

På den måde bliver begge linjer "presset" ned på næste side.

Ved eksempel med 1 linje med noget i kol H.
------- sideskift ----------
****


Ved eksempel med 2 linje med noget i kol H.
------- sideskift ----------
****
****


Oprindelig kode:

Sub sideskift()
On Error GoTo Ingen_sideskift
Application.ScreenUpdating = True
   
   
    Range(Range("F65536").End(xlUp).Address).Select
    Application.ScreenUpdating = False

    ActiveSheet.PageSetup.PrintArea = "$A:$F"
   
    For Each pb In Worksheets("ark1").HPageBreaks
        I = pb.Location.Row
        If Rows(I).PageBreak = xlPageBreakAutomatic Then
            If Cells(I, "H") = "" Then
                A = Cells(I, "H").End(xlUp).Row
                Rows(A).PageBreak = xlPageBreakManual
            End If
        End If
    Next pb

    With Worksheets("ark1").HPageBreaks
        I = .Item(.Count).Location.Row
        If Rows(I).PageBreak = xlPageBreakAutomatic Then
            If Cells(I, "H") = "" Then
                A = Cells(I, "H").End(xlUp).Row
                Rows(A).PageBreak = xlPageBreakManual
            End If
        End If
    End With

    Set Rng = Nothing
    Range("A1").Select

Ingen_sideskift:

End Sub