Betinget sideskift

Prøv

Sub Sideskift()
For Each c In Range("A2:A65000").Cells
    If UCase(c.Value) = "KUNDENR." Then
        ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=c
    End If
Next
End Sub

Denne version starter med at fjerne allerede indsatte sideskift, og der kan stå noget efter Kundenr. i cellen.

Sub InsertPagebreak()
    Dim cell As Range
    Dim index As Long
    Dim soegetext As String
   
    soegetext = "Kundenr."
   
    For index = ActiveSheet.HPageBreaks.Count To 1 Step -1
        ActiveSheet.HPageBreaks(index).Delete
    Next index
   
    For Each cell In Range("a:a")
        If Left(cell.Value, Len(soegetext)) = soegetext Then
            ActiveSheet.HPageBreaks.Add Before:=cell
        End If
    Next cell
End Sub

Hej jkrons og Niels Bjarne
Tak for svarene.
Jeg har ikke den rigtige fil ved hånden, men har lavet en test.
jkrons svar virker, men jeg har tænkt mig at efterfølge Niels Bjarne's mere avancerede og mere korrekte svar til mit brug.
Men Niels Bjarne, dit svar giver en Fejl 1004
Application or objectdefined error
i linien:

ActiveSheet.HPageBreaks.Add Before:=cell

Jeg kan dog ikke umiddelbart se hvorfor, da det ser korrekt ud, uden dog at være ekspert.
Men den fjerner dog jkrons indsatte sideskift
Mvh  Mads

Jeg ved ikke hvad fejlen hos dig skyldes. Fejlmeldingen siger mig ikke noget. Jeg har testet koden hos mig, og der giver den ingen fejl.
Men for at finde en løsning til dig, har jeg ændret mit forslag med dele af jkrons forslag (jkrons ved mere om Excel end jeg gør ;-), da hans forslag virker ved dig.
Du skal dog være opmærksom på, at hvis du har flere faner markeret, når du afvikler makroen, så fjernes kun sideskift på den aktive fane, mens der indsættes nye sideskift i alle markerede faner. Har du kun en fane markeret, så skulle det virke.


Sub InsertPagebreak()
    Dim cell As Range
    Dim index As Long
    Dim soegetext As String
   
    soegetext = "KUNDENR."
   
    For index = ActiveWindow.SelectedSheets.HPageBreaks.Count To 1 Step -1
        ActiveWindow.SelectedSheets.HPageBreaks(index).Delete
    Next index
   
    For Each cell In Range("a:a")
        If UCase(Left(cell.Value, Len(soegetext))) = soegetext Then
            ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=cell
        End If
    Next cell
End Sub

Hej Niels Bjarne
Da jeg kom på arbejdet og prøvede på den rigtige fil, så stoppede din makro allerede ved:
ActiveWindow.SelectedSheets.HPageBreaks(index).Delete
Din reviderede makro stopper også samme sted med fejlmeddelsen: Subscript out of range.
Men jeg har ændret lidt i din første makro, således at det virker i min fil.
Sub InsertPagebreak()
    Dim cell As Range
    Dim soegetext As String
   
    soegetext = "Kundenr."
    ActiveSheet.ResetAllPageBreaks
     
    For Each cell In Range("a:a")
        If Left(cell.Value, Len(soegetext)) = soegetext Then
          ActiveSheet.HPageBreaks.Add Before:=cell
        End If
    Next cell
End Sub

Mange tak for hjælpen