Home |
Search |
Today's Posts |
|
#1
|
|||
|
|||
Inserting header @ page break
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 |
#2
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Page scaling & Page break preview prob | Excel Discussion (Misc queries) | |||
Keyboard Shortcut for Inserting a Page Break | Excel Discussion (Misc queries) | |||
Can't delete a page break | Excel Discussion (Misc queries) | |||
adding a new page break to an existing page break | Excel Discussion (Misc queries) | |||
content does not stay in page break | Excel Worksheet Functions |