I have a macro that inserts lines and copy a header when ever the value in B
Changes.
I want to make it a bit easier the 26 lines must be inserted and range
B2:K25 coppied at every page break.

Thanks

Public Sub Deilv2()
Dim LastRow As Long
Dim row_index As Long
Dim rng As Range
Set rng = Range("B2:K25")
Application.ScreenUpdating = False
LastRow = ActiveSheet.Cells(Rows.Count, "b").End(xlUp).Row
For row_index = LastRow - 1 To 26 Step -1
If Cells(row_index, "B").Value < _
Cells(row_index + 1, "B").Value Then
Cells(row_index + 1, "B").Resize(26).EntireRow. _
insert Shift:=xlDown
rng.Copy Destination:=Cells(row_index + 1, "B").Offset(2)
End If
Next
Application.ScreenUpdating = True
End Sub

Maybe you could incorporate this into your code:

Option Explicit
Sub testme01()

Dim HorzPBArray()
Dim curWks As Worksheet
Dim newWks As Worksheet
Dim i As Long

Set curWks = ActiveSheet
With curWks
.DisplayPageBreaks = False
End With

ActiveWorkbook.Names.Add Name:="hzPB", _
RefersToR1C1:="=GET.DOCUMENT(64,""" & _
ActiveSheet.Name & """)"

ActiveWorkbook.Names.Add Name:="vPB", _
RefersToR1C1:="=GET.DOCUMENT(65,""" & _
ActiveSheet.Name & """)"

i = 1
While Not IsError(Evaluate("Index(hzPB," & i & ")"))
ReDim Preserve HorzPBArray(1 To i)
HorzPBArray(i) = Evaluate("Index(hzPB," & i & ")")
i = i + 1
Wend

ReDim Preserve HorzPBArray(1 To i - 1)

For i = UBound(HorzPBArray) to LBound(HorzPBArray) step -1
If curWks.Rows(HorzPBArray(i)).PageBreak = xlPageBreakManual Then
MsgBox HorzPBArray(i)
End If
Next i

End Sub

horzPBArray will be an array of row numbers that have pagebreaks. The code
limits it to just manual pagebreaks (with xlpagebreakmanual).

(I took this code from one of Tom Ogilvy's posts.)


Esrei wrote:

I have a macro that inserts lines and copy a header when ever the value in B
Changes.
I want to make it a bit easier the 26 lines must be inserted and range
B2:K25 coppied at every page break.

Thanks

Public Sub Deilv2()
Dim LastRow As Long
Dim row_index As Long
Dim rng As Range
Set rng = Range("B2:K25")
Application.ScreenUpdating = False
LastRow = ActiveSheet.Cells(Rows.Count, "b").End(xlUp).Row
For row_index = LastRow - 1 To 26 Step -1
If Cells(row_index, "B").Value < _
Cells(row_index + 1, "B").Value Then
Cells(row_index + 1, "B").Resize(26).EntireRow. _
insert Shift:=xlDown
rng.Copy Destination:=Cells(row_index + 1, "B").Offset(2)
End If
Next
Application.ScreenUpdating = True
End Sub

--

Dave Peterson