VBA - Printing Records to Single PDF

[imt]

So, I had watched MrExecl's 4 part series on printing specific records with the last using Marco /VBA to print each of the records to the printer.

Print Each Record with a Macro - Part IV of IV: Podcast #1549

However, I am looking to see if there is a way to take this one step further and instead of printing this one sheet singly for each and every record, is there a way to print/save these all to one single PDF file:

For example, if you run my modified VBA Module Code, derived from MrExcels Part IV Video:

Sub PrintAll()
    RowCount = Worksheets("Reviews").Cells(Rows.Count, 1).End(xlUp).Row - 1
    
    Worksheets("Print Reviews").Select
    For i = 1 To RowCount
        Range("B1").Value = i
        [B]ActiveSheet.PrintOut Copies = 1[/B]
        i = i + 1
    Next i
    
    
End Sub

This would print out a sheet to the printer from the "PrintReviews" sheet for each incremental odd row that is found on the "Reviews" sheet. For example in my case, I would have like 50 sheets of printed paper. Is there a way to somehow save this to a PDF but as a single file that contains the 50 total pages versus 1 PDF or Printout from each single row?

 

[davesexcel]

With your loop you can copy the sheet and add it to an array of sheets, then saveas all the sheets as a .pdf, then delete the array of sheets.

Change your file location and name in the code.

Sub PrintAll()
    Dim sh As Worksheet, x As Variant
    Dim ArraySheets() As String
    RowCount = Worksheets("Reviews").Cells(Rows.Count, 1).End(xlUp).Row - 1
    Application.ScreenUpdating = False
    
    With Worksheets("Print Reviews")
        For i = 1 To RowCount
            .Range("B1").Value = i
            .Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = i
            ReDim Preserve ArraySheets(x)
            ArraySheets(x) = ActiveSheet.Name
            i = i + 1
            x = x + 1
        Next i

    End With
    
    With Sheets(ArraySheets)
        .Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                        Filename:="C:\Users\davem\AppData\Local\Temp\New folder" & "\" & ThisWorkbook.Name
        Application.DisplayAlerts = False
        .Delete
    End With
    MsgBox "Finished"
End Sub