VBA to Print Specific Pages From Multiple Sheets to Single PDF with a Specific Name

[RussPlanert]

I have a workbook w 3 tabs that I am looking to write a macro to print in the following manner into a single PDF:

Sheet2 = Print pages 1-8
Sheet1 = Print pages 1-4
Sheet3 = Print pages 1-6

Name them with name listed in cell E600 of

I am familiar with the below macro, but am admittedly extremely new to this and would love some assistance getting Sheet1 and Sheet3

Sub SaveEstimates()

Dim SavePath As String
Dim ProgramName As Range

Set ProgramName = Sheet2.Range("E600")

SavePath = "C:\Desktop\Save Folder" & "\" & ProgramName

Sheet2.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
SavePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False, _
From:=1, To:=8

End Sub

 

[John_w]

I assume you've given the tab names of the sheets because Sheet2 in the code below is actually the VBA code name, which happens to be the same as its tab name "Sheet2".

Set ProgramName = Sheet2.Range("E600")

The only way to create a single PDF from multiple sheets, purely with Excel or without a third-party tool, is to copy and paste the required rows to a temporary sheet and save that as a PDF.

This macro does that and should preserve the original column widths, row heights and cell formats in the output PDF. The way sheet names and page numbers are specified in the allPages array allows any order of the sheet names and their page numbers and any sheets and page numbers can be repeated - an example is shown in the code.

Public Sub Create_PDF_Pages()

    Dim currentSheet As Worksheet
    Dim currentView As Long
    Dim PDFsheet As Worksheet
    Dim destCell As Range
    Dim copyRange As Range
    Dim pageBreak As HPageBreak
    Dim page1StartCell As Range
    Dim PDFoutputFile As String
    Dim sheetName As String
    Dim allPages As Variant, pagesCsv As Variant, pagesRange As Variant
    Dim pageNumber As Long
   
    allPages = Split("Sheet2!1-8,Sheet1!1-4,Sheet3!1-6", ",")   'sheet tab names and their page numbers
    'allPages = Split("Sheet1!1,Sheet2!1,Sheet3!1,Sheet1!2,Sheet2!2,Sheet3!2", ",")   'example - page 1 of each sheet followed by page 2 of each sheet
           
    PDFoutputFile = "C:\Desktop\Save Folder\" & Worksheets("Sheet2").Range("E600").Value & ".pdf"

    Application.ScreenUpdating = False  

    With ActiveWorkbook
        Set currentSheet = .ActiveSheet
        Set PDFsheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
    End With
    Set destCell = PDFsheet.Range("A1")
       
    With ActiveWindow
        currentView = .View
        .View = xlPageBreakPreview
    End With
       
    'Copy specified pages to the PDF output sheet
   
    For Each pagesCsv In allPages
   
        sheetName = Split(pagesCsv, "!")(0)
        pagesRange = Split(Split(pagesCsv, "!")(1), "-")
       
        With ActiveWorkbook.Worksheets(sheetName)
       
            Set page1StartCell = .UsedRange.Range("A1")
                       
            For pageNumber = pagesRange(0) To pagesRange(UBound(pagesRange))
               
                Set pageBreak = .HPageBreaks(pageNumber)
               
                'Set rows for this page and copy them to clipboard
               
                If pageNumber = 1 Then
                    'Set range to copy for page 1 from the start of page 1 to the page 1 page break
                    Set copyRange = Range(page1StartCell, pageBreak.Location.Offset(-1)).EntireRow
                Else
                    'Set range to copy for all other pages from the start of the previous page's page break to this page's page break
                    Set copyRange = Range(.HPageBreaks(pageNumber - 1).Location, pageBreak.Location.Offset(-1)).EntireRow
                End If
               
                copyRange.Copy
               
                'Paste to destination cell in PDF output sheet
               
                destCell.Select
                destCell.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                destCell.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                destCell.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
           
                'Use Format Painter to copy and paste row heights in PDF output sheet
               
                copyRange.EntireRow.Copy
                destCell.EntireRow.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                          
                'Update destination cell for next page in PDF output sheet
               
                With PDFsheet
                    Set destCell = .Cells(.UsedRange.Rows.Count + 1, 1) 'last row in used range
                End With
               
            Next
       
        End With
       
    Next
           
    'Save the PDF output sheet as a PDF
   
    With PDFsheet
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFoutputFile, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
       
    ActiveWindow.View = currentView
    currentSheet.Activate
           
    Application.ScreenUpdating = True
       
    MsgBox "Created " & PDFoutputFile
   
End Sub

 

[Ark68]

Hi John, I'm hoping you can help me understand your code.

I do have a question to start, and in all likelihood will have more.

In this example, in this line, the sheets are static. Always printing sheet2!1-8, Sheet1!1-4 ...

allPages = Split("Sheet2!1-8,Sheet1!1-4,Sheet3!1-6", ",")

In my case, how do I adapt this if the number of pages on my worksheet (which is dynamically named) is dynamic. I could have any number of pages in this worksheet. I'm assuming "pages" are the equivalent of pages you would get from setting the print area? Following each individual page of pages in worksheet1, I would print the single page (static) on worksheet 2 onto the reverse side.

I'm stumped early on and can't continue until I wrap myself around understanding this initial step.

 

[John_w]

Yes, 'pages' are the pages in the print area (Page Setup).

It sounds like you need to dynamically build the list of sheets and pages (the string which is Split to create the allPages array), depending on the number of pages in worksheet1, and this code should help because it shows the number of pages in each sheet:

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        Debug.Print ws.Name, ws.PageSetup.Pages.Count
    Next

You could use sheet indexes instead of names in the list of sheets and pages:

allPages = Split("2!1-8,1!1-4,3!1-6", ",")

with this:

    Dim sheetIndex As Long
        sheetIndex = Split(pagesCsv, "!")(0)
        pagesRange = Split(Split(pagesCsv, "!")(1), "-")
        
        With ActiveWorkbook.Worksheets(sheetIndex)