Hi,
Try this. untested.
Code:Sub Print_Ranges() Dim strShtname As String, strRngName As String Dim i As Long, strFileName As String With Worksheets("INDEX") 'sort the named range list according to page number order .Range("A2").CurrentRegion.Sort key1:=Range("A3"), order1:=xlAscending, Header:=xlYes, ordercustom:=1, Orientation:=xlTopToBottom 'loop through the cells and determine parent of named range and specific range addresses For i = 3 To 38 strRngName = .Cells(i, 2).Text strShtname = Range(strRngName).Parent.Name strFileName = ThisWorkbook.Path & "\" & strShtname & Format(Date, "mm-dd-yy") & ".pdf" 'clear any existing print areas and reset to named ranges areas With Worksheets(strShtname) .PageSetup.PrintArea = "" .PageSetup.PrintArea = Range(strRngName).Address .PrintOut ' .PrintPreview '// Save the print area as a PDF file .ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFileName, _ Quality:=xlQualityStandard, IncludeDocProperties:=True, _ IgnorePrintAreas:=False, OpenAfterPublish:=False End With Next i End With End Sub




Reply With Quote
Bookmarks