Convert multiple ranges to single PDF, with ranges separated - excel

Question

I convert multiple ranges on different worksheets to a single PDF.
Private Sub CommandButton1_Click()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim vFile As Variant
Dim sFile As String
Set ws1 = Worksheets("Sheet1")
ws1.PageSetup.PrintArea = "B2:K51"
Set ws2 = Worksheets("Sheet2")
ws2.PageSetup.PrintArea = "A3:J52, J3:S52, S3:AE52"
Worksheets(Array(ws1.Name, ws2.Name)).Select
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=vFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "PDF file has been created."
End If
End Sub
The PrintArea range for ws2 creates a single range.
How do I separate the ranges so the output is three ranges instead of one?

Answer 1

Export to PDF
The solution inserts a new worksheet and copies the ranges to it. Then it exports the new worksheet to PDF and deletes the new worksheet.
Sheet Module e.g. Sheet1 (where the command button is)
Option Explicit
Private Sub CommandButton1_Click()
exportToPDF
End Sub
Standard Module e.g. Module1
Option Explicit
Sub exportToPDF()
' Define constants.
Const Gap As Long = 0
Const vFile As String = "F:\Test\Export.pdf"
Dim Ranges1 As Variant
Ranges1 = Array("B2:K51")
Dim Ranges2 As Variant
Ranges2 = Array("A3:J52", "J3:S52", "S3:AE52")
' Define workbook.
Dim wb As Workbook
Set wb = ThisWorkbook ' The workbook containing this code.
' Define worksheets.
Dim ws1 As Worksheet
Set ws1 = Worksheets("Sheet1")
Dim ws2 As Worksheet
Set ws2 = Worksheets("Sheet2")
Dim ws3 As Worksheet
Set ws3 = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
' Copy ranges from first to third worksheet.
Dim rng As Range
Dim CurrRow As Long
CurrRow = 1
Dim j As Long
Dim RowsCount As Long
Dim ColsCount As Long
For j = LBound(Ranges1) To UBound(Ranges1)
Set rng = ws1.Range(Ranges1(j))
rng.Copy
ws3.Cells(CurrRow, 1).PasteSpecial xlPasteValues
ws3.Cells(CurrRow, 1).PasteSpecial xlFormats
If ColsCount < rng.Columns.Count Then
ColsCount = rng.Columns.Count
End If
CurrRow = CurrRow + rng.Rows.Count + Gap
Next j
' Copy ranges from second to third worksheet.
For j = LBound(Ranges2) To UBound(Ranges2)
Set rng = ws2.Range(Ranges2(j))
rng.Copy
ws3.Cells(CurrRow, 1).PasteSpecial xlPasteValues
ws3.Cells(CurrRow, 1).PasteSpecial xlFormats
If ColsCount < rng.Columns.Count Then
ColsCount = rng.Columns.Count
End If
CurrRow = CurrRow + rng.Rows.Count + Gap
Next j
' Export and close third worksheet.
With ws3
Set rng = .Range("A1").Resize(CurrRow - Gap - 1, ColsCount)
rng.Columns.AutoFit
.PageSetup.PrintArea = rng.Address
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=vFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
' Inform user.
MsgBox "PDF file has been created."
End Sub
Populate Data (Standard Module)
To quickly see what the code does:
Create a workbook containing worksheets Sheet1 and Sheet2.
Copy all three codes appropriately.
Run populateData.
Run exportPDF.
The Code
Private Sub populateData()
With [Sheet1!B2:K51]
.Formula = "=ROW()&""|""&COLUMN()"
.Interior.ColorIndex = 6
End With
With [Sheet2!A3:AE52]
.Formula = "=ROW()&""|""&COLUMN()"
.Interior.ColorIndex = 8
End With
End Sub