Sub insert_rows()
Dim Row As Long, Column As Long
Dim start_cell As Range
Dim next_NonBlank_cell As Range
Dim next_NonBlank_row As Long
Dim next_page_row As Long
Dim new_rows As Long
Row = (ActiveCell.Row): Column = (ActiveCell.Column)
Application.ScreenUpdating = False
On Error GoTo line_exit
Set start_cell = Cells(Row, 1)
If start_cell = "" Then
Set next_NonBlank_cell = ActiveSheet.Cells.Find(What:="*", After:=start_cell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If next_NonBlank_cell.Row >= start_cell.Row Then
next_NonBlank_row = next_NonBlank_cell.Row
End If
Else
next_NonBlank_row = start_cell.Row
End If
next_page_row = Row
While Rows(next_page_row).PageBreak = xlNone
next_page_row = next_page_row + 1
Wend
new_rows = next_page_row - next_NonBlank_row
If new_rows < 0 Then
Exit Sub
End If
Rows(Selection.Cells(1).Row & ":" & Selection.Cells(1).Row + new_rows - 1).Insert Shift:=xlDown
Rows(Row & ":" & Row + new_rows).Select
With Selection
.NumberFormat = "General"
.WrapText = False
.Style = "Normal"
End With
Cells(Row, Column).Select
Do Until next_NonBlank_row = next_page_row
Set start_cell = Cells(Row + 1, 1)
If start_cell = "" Then
Set next_NonBlank_cell = ActiveSheet.Cells.Find(What:="*", After:=start_cell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If next_NonBlank_cell.Row >= start_cell.Row Then
next_NonBlank_row = next_NonBlank_cell.Row
End If
Else
next_NonBlank_row = start_cell.Row
End If
next_page_row = Row
While Rows(next_page_row).PageBreak = xlNone
next_page_row = next_page_row + 1
Wend
If next_NonBlank_row < next_page_row Then
Rows(Row).Insert
End If
Cells(Row, Column).Select
Loop
Application.ScreenUpdating = True
line_exit:
End Sub