Hi,

Again untested.

Code:
Sub Print_Ranges()

    Dim strShtname As String, strRngName As String
    Dim i As Long, strFileName  As String
    Dim wbkActive   As Workbook
    Dim wbkPDF      As Workbook
    Dim wbkNew      As Workbook
    Dim rngDest     As Range
    Dim RowsCount   As Long
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    Set wbkActive = ThisWorkbook
    Set wbkPDF = Workbooks.Add
    Set rngDest = wbkPDF.Worksheets(1).Range("a1")
    
    With wbkActive.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 = wbkActive.Path & "\" & strShtname & Format(Date, "mm-dd-yy")
            'clear any existing print areas and reset to named ranges areas
            With wbkActive.Worksheets(strShtname)
                .PageSetup.PrintArea = ""
                .PageSetup.PrintArea = Range(strRngName).Address
              
                '// Paste the data to the workbook for PDF
                .Range(strRngName).Copy rngDest
                RowsCount = .Range(strRngName).Rows.Count
                Set rngDest = rngDest.Offset(RowsCount)
                '// Paste the data to a new workbook
                Set wbkNew = Workbooks.Add
                .Range(strRngName).Copy wbkNew.Worksheets(1).Range("a1")
                '// Save the print area as a new file
                wbkNew.SaveAs strFileName, 51
                wbkNew.Close
                Set wbkNew = Nothing
            End With
        Next i
    End With
    
    wbkPDF.Worksheets(1).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    wbkActive.Path & "\" & Format(Date, "mmmmyy") & ".pdf", _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    
    
End Sub