Public Sub Create_PDF2()
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
'PDF file name
PDFfullName = .Path & "\End of Season.pdf"
'Add temporary sheet for PDF output
Set PDFsheet = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
Set destCell = PDFsheet.Range("A1")
'Cell containing data validation in-cell dropdown
Set dataValidationCell = .Worksheets("End of Season").Range("A3")
'Range to be copied to temporary sheet for each dropdown value
Set copyRange = .Worksheets("End of Season").Range("A1:X39")
End With
'Source of data validation list
Set dataValidationListSource = Evaluate(dataValidationCell.Validation.Formula1)
'Loop through each data validation value to update range
For Each dvValueCell In dataValidationListSource
dataValidationCell.Value = dvValueCell.Value
'Copy cell formats, column widths, the picture 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:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Update destination cell to next row
With PDFsheet
'.HPageBreaks.Add Before:=.Rows(.UsedRange.Rows.Count + 1)
Set destCell = .Cells(.UsedRange.Rows.Count + 1, 1)
End With
Next
'Save temporary sheet as PDF then delete it
With PDFsheet
.PageSetup.Orientation = xlPortrait 'xlLandscape
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfullName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
End Sub