Excel VBA code to print each sheet individually and rename based on sheet name

Jonathan865 

Hi Jonathan,

Please have a look at this code.

It iterates through each sheet, prints it and saves it by its name in pdf format.

Let me know if it works for you.

Option Explicit

Sub udsPrintSheetsAndSaveAsPdf()

Dim shtThisSheet As Worksheet
Dim booRC As Boolean

Application.ScreenUpdating = False

booRC = True
For Each shtThisSheet In ActiveWorkbook.Worksheets
Sheets(shtThisSheet.Name).Select
If booRC Then booRC = udfPrintSheet()
If booRC Then booRC = udfSaveAsPdf(shtThisSheet.Name)
Next shtThisSheet

Application.ScreenUpdating = True

End Sub

Function udfPrintSheet() As Boolean

Application.ScreenUpdating = False

With ActiveSheet.PageSetup
.PrintArea = ""
.PrintTitleRows = ""
.PrintTitleColumns = ""
.Orientation = xlPortrait
.PaperSize = xlPaperA4 ' I assume you want to print on A4, if not...
.FitToPagesWide = 1
.FitToPagesTall = 1
End With

Application.PrintCommunication = True
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
Application.PrintCommunication = False

udfPrintSheet = True

End Function

Function udfSaveAsPdf(strSheetName As String) As Boolean

Application.ScreenUpdating = False
Application.DisplayAlerts = False

ChDir "C:\temp" ' I assume you have a C:\temp folder...

ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, Filename:="C:\temp\" & strSheetName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False

Application.DisplayAlerts = True

udfSaveAsPdf = True

End Function