Friday, May 9, 2008

Automatically add page breaks in Excel using VBA

Sub InsertPageBreaks()
Application.ScreenUpdating = False
For p = 1 To Sheets.Count
If (p > 1) Then
ans = MsgBox("Do you want to do the next sheet, Sheet No:" & p & "?", vbYesNo)
If ans = vbNo Then
Application.StatusBar = ""
Exit Sub
End If
Else
Sheets(p).Select
ActiveSheet.ResetAllPageBreaks
Range("B3").Select
ActiveSheet.PageSetup.Zoom = 55
n = 0
For i = 1 To 319
If ActiveCell.Cells(i, 1) <> ActiveCell.Cells(i + 1, 1) Then
n = n + 1
Set ActiveSheet.HPageBreaks(n).Location = Range("A" & i + 3)
Application.ScreenUpdating = True
Application.StatusBar = "Inserted PageBreak at Row: " & i + 3
Application.ScreenUpdating = False
End If
Next
End If
Next
Application.StatusBar = ""
End Sub