Hi AQ,
This macro will copy the original sheet to a new sheet and do the work
there. I put statements in to print the sheet and delete it but I turned
these off since you can go to Print Preview to verify that it works as you
want. Let me know if you have questions.
CHORDially,
Art Farrell
Option Explicit
Sub repeatBotRows()
Dim botRows As Range, botCount As Long
Dim firstPgBk As Long, LasRow As Long
Dim totPages As Long, n As Long, m As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Set botRows = Range("2:7")
Sheets("Sheet1").Copy after:=Sheets("Sheets1")
ActiveSheet.Name = "printOrig"
With ActiveSheet.PageSetup
.printtitlerows = "$1:$1"
End With
firstPgBk = ActiveSheet.HPageBreaks(1).Location.Row - 1
botCount = botRows.Rows.Count
LasRow = Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row
totPages = Application.Ceiling(LasRow / (firstPgBk - botCount - 1), 1)
Range(Rows(firstPgBk - botCount + 1), Rows(firstPgBk)).Select
Selection.EntireRow.Insert Shift:=xlDown
botRows.Copy Range("A" & firstPgBk - botCount + 1)
n = 2
m = 0
Do
Range(Rows(firstPgBk * n - botCount - m), Rows(firstPgBk * n -
m - 1)).Select
Selection.EntireRow.Insert Shift:=xlDown
botRows.Copy Range("A" & firstPgBk * n - botCount - m)
n = n + 1
m = m + 1
Loop Until n > totPages
Application.Calculation = xlCalculationAutomatic
' ActiveSheet.PrintOut
' ActiveSheet.Delete
ActiveSheet.Buttons.Delete
Application.DisplayAlerts = True
End Sub