Try
Sub SaveSelectionToPDF()
Dim rng As Range
Dim newpdfname As String
Dim pdfpath As String
Set rng = Application.Selection
Set rng = Range("D2:I38")
newpdfname = Application.InputBox("Please Enter a name for the new PDF")
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
pdfpath = ThisWorkbook.Path & "\" & newpdfname
rng.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=pdfpath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Update_PO_Report
End Sub
Sub Update_PO_Report()
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("Purchase Order")
Set ws2 = Worksheets("PO report")
caddr = Array("I2", "I3", "I4", "I5", "E7", "I38", "G8", "G9", "G10", "G11")
nxtrec = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = 0 To UBound(caddr)
ws2.Cells(nxtrec, i + 1) = ws1.Range(caddr(i))
Next i
End Sub
Click "Save/PDF" button
Bookmarks