I used this “page setup” macro trick under these scenarios:
- have to do a consistent page setup for more than 60 worksheets
- have to regularly reset the print area for multiple worksheets in the workbook after collected new information from colleagues
VBA macro code
💡Press Alt + F11 to open VBA editor in Excel
|
Sub PageSetup() Application.Calculation = xlCalculationManual Dim bone As Workbook bone.Activate qt = MsgBox("It might take more than 5 mins, confirm to proceed?", vbYesNo) Application.Calculation = xlCalculationAutomatic Else Dim shname As String For a = 1 To bone.Sheets.Count Sheets(a).Activate .RightHeader = "Page &P" End With 'Set print area Sheets(a).Activate Sheets(a).PageSetup.PrintArea = Range(Range("A1"), Cells(lastr, lastcln)).Address End If Application.Calculation = xlCalculationAutomatic End Sub |
Explanation
PageSetup is this macro name, change it as you like, just keep in mind that no space in between the words of the name
Sub PageSetup()
Pre-setting in order to run the macro faster: make the calculation function in manual way and turn off the screen update
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
bone is the name of the workbook in which you trigger this macro, change the name as you like
Dim bone As Workbook
Set bone = ActiveWorkbook
bone.Activate
If it’s more than 40 worksheets, ask for confirmation before running the macro just in case the users doesn’t know how long it might take.
qt = MsgBox("It might take more than 5 mins, confirm to proceed?", vbYesNo)
If the user clicks no, then no need to run the macro
If qt = vbNo Then
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
If the user clicks yes, then run the macro
Else
Start to loop through all worksheets
For a = 1 To bone.Sheets.Count
Sheets(a).Activate
With Sheets(a).PageSetup
All these are optional, just add ‘ at the beginning of each code to turn it into an explanation if it is not necessary or change the values to suit your needs
.RightHeader = "Page &P"
.BottomMargin = Application.InchesToPoints(0.25)
.HeaderMargin = Application.InchesToPoints(0.05)
.LeftMargin = Application.InchesToPoints(0.1)
.RightMargin = Application.InchesToPoints(0.1)
.PaperSize = xlPaperA4
.Zoom = 70
End With
'Set print area
Sheets(a).Activate
Dim as Dimension, to declare variable names and their types, change the names as you like, just keep in mind to keep the same names throughout the macro
Dim lastr As Long
Dim lastcln As Long
Find the last row
lastr = Sheets(a).Range("A10000").End(xlUp).Row
Find the last column
lastcln = Sheets(a).Range("A1").End(xltoRight).column
Redefine the print area
Sheets(a).PageSetup.PrintArea = Range(Range("A1"), Cells(lastr, lastcln)).Address
Next a Then change the next worksheet
This end if is to close the if statement of the question at the beginning of the code
End If
Turn the calculation back to be automatic and turn back on the screen update
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub