Hello,

The macro below works, but runs very slowly when I am running it on about
190 different worksheets all within the same workbook. Is there a way to
speed up the macro? It took ten minutes and did about 90 files.

Thanks in advance.

Sub PrintTitleColumns2()

Dim ws As Worksheet

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each ws In Worksheets
With ws.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = "$I:$I"
.Orientation = xlLandscape
.PaperSize = xlPaperLegal
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.FitToPagesWide = 2
.FitToPagesTall = False
.Zoom = False
.Order = xlOverThenDown
End With

Next ws

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

Before running your macro, change your default printer to "Microsoft Office
Document Image Writer". It should run much faster.

Hope this helps,

Hutch

"ScottMsp" wrote:

Hello,

The macro below works, but runs very slowly when I am running it on about
190 different worksheets all within the same workbook. Is there a way to
speed up the macro? It took ten minutes and did about 90 files.

Thanks in advance.

Sub PrintTitleColumns2()

Dim ws As Worksheet

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For Each ws In Worksheets
With ws.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = "$I:$I"
.Orientation = xlLandscape
.PaperSize = xlPaperLegal
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.FitToPagesWide = 2
.FitToPagesTall = False
.Zoom = False
.Order = xlOverThenDown
End With

Next ws

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub