Export selected sheets as separate pdf files

[manekankit]

[FONT=&quot]Hi,[/FONT]
[FONT=&quot]Need help to create macro to export certain selected sheets as separate pdf files.[/FONT]
[FONT=&quot]Steps are:[/FONT]
[FONT=&quot]1. An excel file is open[/FONT]
[FONT=&quot]2. It contains several sheets[/FONT]
[FONT=&quot]3. It also contains a sheet named "Index"[/FONT]
[FONT=&quot]4. Column A of the sheet "Index" contains name of some of the sheets form the same file.[/FONT]
[FONT=&quot]5. Need to create macro that will export each of the sheets that are mention in range A1, A2 and so on in the sheet "Index"[/FONT]
[FONT=&quot]5. Each pdf file should be saved at a specific location (at ruta4, refer code given below)[/FONT]
[FONT=&quot]6. Each pdf file should be named like (yyyy-mmm-dd) and (sheet name)[/FONT]
[FONT=&quot]I am using below code to create directory. Need help to create macro to select sheets and save these sheets as separate pdf files.
[/FONT]
[FONT=&quot]Sub ExportPdf()
[/FONT]
[FONT=&quot]Dim wb As Workbook[/FONT]
[FONT=&quot]Set wb = ThisWorkbook[/FONT]
[FONT=&quot]Dim ruta As String, ruta2 As String, ruta3 As String, ruta4 As String, nFile As String[/FONT]
[FONT=&quot]nFile = Format(Date, "dd-mmm-yyyy")[/FONT]
[FONT=&quot]ruta = wb.Path & ""[/FONT]
[FONT=&quot]ruta2 = ruta & "export"[/FONT]
[FONT=&quot]If Dir(ruta2, vbDirectory) = Empty Then[/FONT]
[FONT=&quot]MkDir ruta2[/FONT]
[FONT=&quot]End If[/FONT]
[FONT=&quot]ruta3 = ruta2 & "PDF"[/FONT]
[FONT=&quot]If Dir(ruta3, vbDirectory) = Empty Then[/FONT]
[FONT=&quot]MkDir ruta3[/FONT]
[FONT=&quot]End If[/FONT]
[FONT=&quot]ruta4 = ruta3 & nFile & ""[/FONT]
[FONT=&quot]If Dir(ruta4, vbDirectory) = Empty Then[/FONT]
[FONT=&quot]MkDir ruta4[/FONT]
[FONT=&quot]End If[/FONT]
[FONT=&quot]<<<<Macro to create pdf as above steps and save it to ruta4 location>>>>>
[/FONT]
[FONT=&quot]End Sub[/FONT]

 

[DanteAmor]

Try this

Sub ExportPdf()


    Dim wb As Workbook
    Dim ruta As String, ruta2 As String, ruta3 As String, ruta4 As String, nFile As String, wName As String
    Dim ws As Worksheet, sh As Worksheet, hoja As String
    Dim u As Long, exist As Boolean
    
    Set wb = ThisWorkbook
    nFile = Format(Date, "dd-mmm-yyyy")
    ruta = wb.Path & "\"
    ruta2 = ruta & "export"
    If Dir(ruta2, vbDirectory) = Empty Then
        MkDir ruta2
    End If
    ruta3 = ruta2 & "\" & "PDF"
    If Dir(ruta3, vbDirectory) = Empty Then
        MkDir ruta3
    End If
    ruta4 = ruta3 & "\" & nFile
    If Dir(ruta4, vbDirectory) = Empty Then
        MkDir ruta4
    End If
    '
    Set ws = Sheets("Index")
    u = ws.Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To u
        hoja = ws.Cells(i, "A").Value
        exist = False
        wName = Format(Date, "yyyy-mmm-dd") & " " & hoja
        For Each sh In Sheets
            If LCase(sh.Name) = LCase(hoja) Then
                exist = True
                Exit For
            End If
        Next
        If exist Then
            Sheets(hoja).ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=ruta4 & "\" & wName & ".pdf", Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        End If
    Next
    MsgBox "End"
End Sub

 

[manekankit]

Try this

Sub ExportPdf()


    Dim wb As Workbook
    Dim ruta As String, ruta2 As String, ruta3 As String, ruta4 As String, nFile As String, wName As String
    Dim ws As Worksheet, sh As Worksheet, hoja As String
    Dim u As Long, exist As Boolean
   
    Set wb = ThisWorkbook
    nFile = Format(Date, "dd-mmm-yyyy")
    ruta = wb.Path & "\"
    ruta2 = ruta & "export"
    If Dir(ruta2, vbDirectory) = Empty Then
        MkDir ruta2
    End If
    ruta3 = ruta2 & "\" & "PDF"
    If Dir(ruta3, vbDirectory) = Empty Then
        MkDir ruta3
    End If
    ruta4 = ruta3 & "\" & nFile
    If Dir(ruta4, vbDirectory) = Empty Then
        MkDir ruta4
    End If
    '
    Set ws = Sheets("Index")
    u = ws.Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To u
        hoja = ws.Cells(i, "A").Value
        exist = False
        wName = Format(Date, "yyyy-mmm-dd") & " " & hoja
        For Each sh In Sheets
            If LCase(sh.Name) = LCase(hoja) Then
                exist = True
                Exit For
            End If
        Next
        If exist Then
            Sheets(hoja).ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=ruta4 & "\" & wName & ".pdf", Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        End If
    Next
    MsgBox "End"
End Sub

Above code shared by you long back is working well, i have modified a bit and using below version. Can you please help me modify code so that listed sheets are exported as a single pdf file rather than separate pdf files for each sheet.

There is a worksheet called "Index" in column F. Various sheets are listed therein. I am currently using below code to export listed sheets as pdf. Currently all the sheets are individually exported. I want all of them to be saved as pdf in a single pdf file with file name as mentioned in cell F1 of the "Index" Sheet.

Private Sub PDF_Stand()
Sheets("Index").Activate

Application.ScreenUpdating = False
    Dim wb As Workbook
    Dim ruta As String, ruta2 As String, ruta3 As String, ruta4 As String, ruta5 As String, nFile As String, wName As String
    Dim ws As Worksheet, sh As Worksheet, hoja As String
    Dim u As Long, exist As Boolean
   
    Set wb = ActiveWorkbook
    nFile = Format(Date, "dd-mmm-yyyy")
     dt = Format(CStr(Now), "hh_mm")
    ruta = wb.Path & "\"
    ruta2 = ruta & "export"
    If Dir(ruta2, vbDirectory) = Empty Then
        MkDir ruta2
    End If
    ruta3 = ruta2 & "\" & "Pdf"
    If Dir(ruta3, vbDirectory) = Empty Then
        MkDir ruta3
    End If
    ruta4 = ruta3 & "\" & nFile
    If Dir(ruta4, vbDirectory) = Empty Then
        MkDir ruta4
    End If
    ruta5 = ruta4 & "\" & dt
    If Dir(ruta5, vbDirectory) = Empty Then
        MkDir ruta5
    End If
   
    '
    Set ws = Sheets("Index")
    u = ws.Range("F" & Rows.Count).End(xlUp).Row
    For i = 2 To u
        hoja = ws.Cells(i, "F").Value
        exist = False
        wName = hoja & " " & "[" & Format(Date, "dd-mmm-yy") & "]"
        For Each sh In Sheets
            If LCase(sh.Name) = LCase(hoja) Then
                exist = True
                Exit For
            End If
        Next
        If exist Then
            Sheets(hoja).ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=ruta5 & "\" & "[St] " & wName & " [" & dt & "]" & ".pdf", Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        End If
    Next
    Application.ScreenUpdating = True

   
Dim Resp As VbMsgBoxResult

    Resp = MsgBox("PDFs Created." & vbNewLine & "You should look for the file  at " & ruta5 & vbNewLine & vbNewLine & "Do you want to open the folder?", vbInformation + vbYesNo, "Report ready")

    If Resp = vbYes Then
        ThisWorkbook.FollowHyperlink ruta5
    End If

End Sub