Consulting

Results 1 to 3 of 3

Thread: Save Worksheet Tabs as Seperate PDF Files to Folder

  1. #1

    Save Worksheet Tabs as Seperate PDF Files to Folder

    All-

    I have 22 tabs labeled 1-28 for each different location that I want to save as a seperate PDF with the tab name, to my desktop folder called "Branch PDFs". Is this possible?

    Each tab has a specific print area, with row/column labels. The only thing to note on the example file attached, I deleted several other tabs for plan, raw data, plan kpi, etc that I don't want a pdf for. Is it possible to just create pdf's of just the locations, and exclude all other tabs? For example, I want a pdf for 1) McCu, 2 )Kaim, 5) Kapa, all the way to 28) Hilo.

    Thank you for your time and consideration.
    Attached Files Attached Files

  2. #2
    VBAX Contributor
    Joined
    Nov 2020
    Location
    Cochin, Kerala
    Posts
    194
    Location
    Sub Saveaspdf()
        Dim xSht   As Worksheet
        Dim xFolder As String
        Dim xYesorNo As Integer
        Dim xUsedRng As Range
        Dim xName  As String
    
    
    
    
        For Each xSht In ActiveWorkbook.Worksheets
            Select Case LCase(xSht.Name)
                Case "plan", "raw data", "plan kpi"   'Define here the sheets to be excluded
                    GoTo NextSheet
                Case Else
                    xName = xSht.Name
            End Select
            xFolder = Environ("USERPROFILE") & "\Desktop\Branch PDFs"
            xFolder = xFolder + "\" + xSht.Name + ".pdf"
            'Check if file already exist
            If Len(Dir(xFolder)) > 0 Then
                xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
                           vbYesNo + vbQuestion, "File Exists")
                On Error Resume Next
                If xYesorNo = vbYes Then
                    Kill xFolder
                Else
                    MsgBox "Proceeding with Next Sheet."
                    GoTo NextSheet
                End If
                If Err.Number <> 0 Then
                    MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
                         & vbCrLf & vbCrLf & "Proceeding with Next Sheet.", vbCritical, "Unable to Delete File"
                    GoTo NextSheet
                End If
            End If
            
            Set xUsedRng = xSht.UsedRange
            If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
                'Save  as PDF file
                xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
            Else
                MsgBox "Sheet " & xSht.Name & "is blank"
            End If
    NextSheet:
        Next xSht
        MsgBox "Completed"
    End Sub
    Last edited by anish.ms; 07-27-2021 at 08:20 PM.

  3. #3
    Wow, thanks Anish! Tried it works great!! Thank you so much!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •