Public Sub Create_PDF_Report()
Dim PDFfullName As String
Dim PDFsheet As Worksheet
Dim destCell As Range
Dim dataValidationCell As Range, dataValidationListSource As Range, dvValueCell As Range
Dim copyRange As Range
With ActiveWorkbook
'Cell containing data validation in-cell dropdown
Set dataValidationCell = .ActiveSheet.Range("I4")
'Range to be copied to temporary PDF sheet for each dropdown value
Set copyRange = .ActiveSheet.Range("B2:G36")
'PDF file name
PDFfullName = .Path & "\Report.pdf"
'Add temporary sheet for PDF output
Set PDFsheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
'Set destination cell on temporary sheet to same column as source data, in order to copy same column widths
Set destCell = PDFsheet.Range("B1")
End With
'Source of data validation list
Set dataValidationListSource = Evaluate(dataValidationCell.Validation.Formula1)
'Loop through each data validation value to update copyRange values
For Each dvValueCell In dataValidationListSource
dataValidationCell.Value = dvValueCell.Value
'Copy cell formats, column widths and cell values to next cell in temporary PDF sheet
copyRange.Copy
destCell.Select
destCell.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
destCell.Worksheet.Paste
destCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Use Format Painter to apply row heights
copyRange.EntireRow.Copy
With PDFsheet
.Range(destCell, .Cells(.UsedRange.Rows.Count, 1)).EntireRow.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With
'Add page break and update destination cell to next row
With PDFsheet
.HPageBreaks.Add Before:=.Rows(.UsedRange.Rows.Count + 1)
Set destCell = .Cells(.UsedRange.Rows.Count + 1, destCell.Column)
End With
Next
'Add page footer to temporary sheet, save it as a PDF and then delete it
With PDFsheet
.PageSetup.Orientation = xlPortrait 'xlLandscape
.PageSetup.CenterFooter = "Page &P"
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfullName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
End Sub