pagebreaks aanpassen over enkel ingevulde deel

[renew000]

Wie o wie kan mij helpen met onderstaand script.

Ik vraag me namelijk af hoe ik dit script enkel kan laten toepassen op een bepaalde selectie.
Nu is het namelijk zo dat de pagebreaks van het gehele document worden aangepast, maar dit hoeft uiteraard niet voor het gedeelte waar er geen inhoud is.

Op dit moment is het zo in mijn document dat de selectie waarover de pagebreaks moeten worden gewijzigd geen aaneengesloten regels zijn. Er zitten bijvoorbeeld maximaal 3 witregels tussen de blokken in kolom A.De pagebreaks zorgen ervoor dat blokken informatie niet worden gesplitst.

Sub PageBreaks()

    On Error Resume Next

Dim lRij As Long, lRijEinde As Long, lRijBreak As Long, Kolom As String
  
'indien opeenvolgende cellen in deze kolom dezelfde inhoud hebben, dan veronderstelt dat dat ze niet gescheiden mogen worden

Kolom = "I"

    lRijEinde = Cells(Rows.Count, Kolom).End(xlUp).Row

'verwijder alle vroeger handmatige horizontale paginaeindes

    For lRij = 2 To lRijEinde
        
        ActiveSheet.Rows(lRij).PageBreak = xlPageBreakNone
    
    Next

'loop nu alle rijen af en als het pagina-einde midden in een blok staat,
'dan moet deze verhuizen naar het begin van de blok

    For lRij = 1 To lRijEinde
        If Cells(lRij, Kolom) = "" Then lRijBreak = lRij
        If ActiveSheet.Rows(lRij).PageBreak <> xlPageBreakNone Then
            
            ActiveSheet.Rows(lRij).PageBreak = xlPageBreakNone
      
            ActiveSheet.Rows(lRijBreak).PageBreak = xlPageBreakManual
        End If
    Next

End Sub

Alvast bedankt voor de moeite

greetz