Macro for creating a PDF of multiple different ranges across multiple sheets

Question

I am trying to make a macro that creates a PDF file of different specified ranges across different sheets. The current code im working with:

 Sub Macro1()

Sheets("Administratief").Activate
ActiveSheet.Range("A1:F22").Select
Sheets("Spuiwater TID").Activate
ActiveSheet.Range("B4:F17").Select

Sheets(Array("Administratief", "Spuiwater TID")).Select

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    FormName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    True
    
End Sub

The problem with this is that it uses the range of "A1:F22" in both sheets instead of using the range of B4:B17. Is there a way to fix this?

Answer 1

I'm not that familiar with VBA yet (getting to know the basics myself, just recently). But perhaps you could try to copy both ranges into a new sheet, then work out what you are doing with the data (putting them in an array and outputting into a PDF), and then delete the newly created sheet.

My way of 'learning' VBA is by basically recording a macro of whatever I'm doing, then putting them together in a way that I feel like it should work.

Hope that helps!

Answer 2

Try it, maybe this is what you wanted? Saves the selected ranges into two separate PDF files, maybe I misunderstood you. Part of the code was found on this forum and adapted to your needs. The user chooses the range himself:

Option Explicit

Sub Export_v1()
    Dim shArr       As Variant
    Dim wb          As Workbook
    Dim strPath     As String
    Dim myFile      As Variant
    Dim rng         As Range
    On Error GoTo errHandler

    Set wb = ThisWorkbook
    Set shArr = Sheets(Array("Administratief", "Spuiwater TID"))
    strPath = ThisWorkbook.Path

    If strPath = "" Then
        strPath = Application.DefaultFilePath
    End If

    strPath = strPath & "\"

    For Each shArr In ThisWorkbook.Worksheets

        ' The user chooses the range himself
        Set rng = Application.InputBox("Please, Select a Range: ", "Prompt to select a range for the print area on the selected worksheet", Type:=8).Areas(1)
        shArr.PageSetup.PrintArea = rng.Address

        myFile = Application.GetSaveAsFilename _
                (InitialFileName:=strPath, _
                FileFilter:="PDF (*.pdf), *.pdf", _
                Title:="Select folder and filename to save")

        shArr.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=myFile, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
        Set rng = Nothing
    Next shArr

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not export file", vbCritical, "Export"
    Resume exitHandler
    Set shArr = Nothing
    Set wb = Nothing
End Sub

Fixed range without request:

Option Explicit

Sub Export_v2()
    Dim shArr       As Variant
    Dim wb          As Workbook
    Dim strPath     As String
    Dim myFile      As Variant
    Dim rng         As Range
    On Error GoTo errHandler

    Set wb = ThisWorkbook
    Set shArr = Sheets(Array("Administratief", "Spuiwater TID"))
    strPath = ThisWorkbook.Path

    If strPath = "" Then
        strPath = Application.DefaultFilePath
    End If

    strPath = strPath & "\"

    For Each shArr In ThisWorkbook.Worksheets

        ' Fixed range without request
        If shArr.Name = "Administratief" Then
            shArr.PageSetup.PrintArea = shArr.Range("A1:F22").Address
        
        ElseIf shArr.Name = "Spuiwater TID" Then
            shArr.PageSetup.PrintArea = shArr.Range("B4:F17").Address
        Else

        End If

        myFile = Application.GetSaveAsFilename _
                (InitialFileName:=strPath, _
                FileFilter:="PDF (*.pdf), *.pdf", _
                Title:="Select folder and filename to save")

        shArr.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=myFile, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
        Set rng = Nothing
    Next shArr

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not export file", vbCritical, "Export"
    Resume exitHandler
    Set shArr = Nothing
    Set wb = Nothing
End Sub

Good luck.