Sub MrE_1222829_161490E_Update_printPDF()
' https://www.mrexcel.com/board/threads/vb-script-to-save-results-to-a-single-pdf-fila.1222829/
' Created: 20221122
' By: HaHoBe
' Version: 2
' Updated: 20221125
' Reason: Code commented
Dim lngRow As Long 'counter for looping through the rows
Dim strTempName As String 'used as left of name for copied sheets
Dim wks As Worksheet 'object to cycle through all worksheets
Const cblnDeleteTempSheets As Boolean = False 'boolean to decide whether to delete the
'copied sheets or hold them for control
'/// setting the left part of the new sheetname
strTempName = "Test " & Format(Date, "yyyymmdd") & " - "
'/// turning the update for display off for speed
Application.ScreenUpdating = False
'/// working from start to last as indicated
For lngRow = 5 To 15
With Sheets("Sheet1")
'/// transfer the value from Sheet1 Column I and row as per looper to
'/// Sheets Result in given cell M13
Sheets("Results").Cells(13, "M") = .Cells(lngRow, "I")
'/// copy Sheets Result to the end of the sheets
Sheets("Results").Copy after:=Sheets(Sheets.Count)
'/// assigning the new name consisting of left part and Number of Worksheets in Workbook
ActiveSheet.Name = strTempName & Worksheets.Count
End With
Next lngRow
'/// loop through all worksheets in workbook
For Each wks In Worksheets
With wks
'/// check if the name starts with the temp name, if so, start grouping
If Left(.Name, Len(strTempName)) = strTempName Then .Select Replace:=False
End With
Next wks
'/// make sure that the activesheet is part of the grouping so activate the last worksheet
Worksheets(Worksheets.Count).Activate
'/// using the next command says export the active sheet to PDF,
'/// since we have grouped them the array of sheets is chosen instead
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\Result\Total " & Format(Now, "yymmdd_hhmmss") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False '
'ActiveWindow.SelectedSheets.PrintOut ActivePrinter:="Microsoft Print to PDF", _
PrintToFile:=True, _
PrToFileName:="C:\Result\Total " & Format(Now, "yymmdd_hhmmss") & ".pdf"
'/// for control of what is actually visible on the sheets the deletion of sheets
'/// will only take place if the bollean is set to True
If cblnDeleteTempSheets Then
'/// turn off the information about deletio of sheets
Application.DisplayAlerts = False
'/// loop through all worksheets in workbook
For Each wks In Worksheets
With wks
'/// check if the name starts with the temp name, if so, delete sheet
If Left(.Name, Len(strTempName)) = strTempName Then .Delete
End With
Next wks
End If
'/// turn on information and screenupdating
With Application
.DisplayAlerts = True
.ScreenUpdating = False
End With
End Sub