Add page break every x rows after specific value excel vba

问题

I'm having a hard time to figure out how to combine two macros I have (see below). What I would like to achieve is to automatically insert a pagebreak every (lets say) 80 rows. Now comes the part that I can't seem to manage.

After every 80 rows it will search up to the first specific search value "total" in column H and add the page break, so the pagebreak in row 80 can only change to less (e.g. row 75). The thing is that in the range of 80 rows there are multiple "total". So it must search for the last "total" before row 80.

After it finds the last "total" in the first 80 rows it must do the same for the next 80 rows. So if the pagebreak is in row 75, the next range must search until row 155 and do the same again, etc.

I have two individual codes that work. The first one adds a pagebreak every 80 rows.

The second one searches for ALL the values "total". So now there are pagebreaks in row 30, 42, 75 (these values are different every proyect) and I only want the last one closest row 80.

This is the first code I found:

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Lastrow1 = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, _  
LookIn:=xlValues, SearchDirection:=xlPrevious).row
Worksheets("sheet1").PageSetup.PrintArea = "$B11:$L" & Lastrow1 + 1

Dim Lastrow As Long
Dim Row_Index As Long
Dim RW As Long

RW = 80

With ActiveSheet
    .ResetAllPageBreaks
    Lastrow = .Cells(rows.Count, "H").End(xlUp).row + 1
    For Row_Index = RW + 1 To Lastrow Step RW
        .HPageBreaks.Add Before:=.Cells(Row_Index, 1)
    Next
End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

This is the second code:

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Lastrow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, _ 
LookIn:=xlValues, SearchDirection:=xlPrevious).row
Worksheets("sheet1").PageSetup.PrintArea = "$B11:$L" & Lastrow + 1

Dim row As Range

ActiveSheet.ResetAllPageBreaks

For Each row In ActiveSheet.UsedRange.rows
    Select Case row.Cells(8).Text
    Case "Total:"
        ActiveSheet.HPageBreaks.Add Before:=row.Cells(1).Offset(6, 0)
    End Select
Next row

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

I hope I explained my problem correctly. Thank you for your time.

回答1:

Sub Macro1() 
    Dim lastrow As Long, rngTemp As Range 

    lastrow = Range("H1").Offset(Rows.Count - 1).End(xlUp).Row 
    Set rngTemp = Range("H1") 

    Do While rngTemp.Row <> lastrow 
        Set rngTemp = Range("H1", rngTemp.Offset(80)).Find(What:="Total", SearchDirection:=xlPrevious) 
        rngTemp.Parent.HPageBreaks.Add Before:=rngTemp.Offset(1, -7) 
    Loop 
End Sub

来源：https://stackoverflow.com/questions/28959736/add-page-break-every-x-rows-after-specific-value-excel-vba

标签

excel

vba

excel-vba

page-break