Welcome to the forum.
Try this and see if it does as you need - basic code, no error handling.
Row-1 is assumed to be a header. The code must go into a standard module.
1. Alt + F11 to open the VB Editor
2. Menu > Insert > Module (not class module)
3. Copy and paste code into code window
4. Adjust sheet and/or range references if needed
5. Alt + Q to close editor
6. Alt + F8 to open the Macro Dialog (be sure the target worksheet is active before running the macro
Option Explicit
Sub Set_PageBreaks()
Dim lastrow As Long, c As Range
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
ActiveSheet.ResetAllPageBreaks
For Each c In Range("A2:A" & lastrow)
If c.Offset(1, 0).Value <> c.Value And c.Offset(1, 0) <> "" Then
c.Offset(1, 0).PageBreak = xlPageBreakManual
End If
Next c
Application.ScreenUpdating = True
End Sub
Or, just looping visible cells after advance filtering for unique values
Option Explicit
Sub Insert_Hbreaks()
Dim c As Range, lastrow As Long, startrow As Long
Application.ScreenUpdating = False
With Sheet1
.ResetAllPageBreaks
.AutoFilterMode = False
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
startrow = WorksheetFunction.CountIf(.Range("A2:A" & lastrow), .Range("A2").Value) + 1
.Range("A1:A" & lastrow).AdvancedFilter xlFilterInPlace, , , True
For Each c In .Range("A" & startrow & ":A" & lastrow).SpecialCells(12)
Range("A" & c.Offset(1, 0).Row - 1).PageBreak = xlPageBreakManual
Next c
.ShowAllData
End With
Application.ScreenUpdating = True
End Sub
Bookmarks