VBA save as PDF to a single file IF condition met

Daniel_72

New Member
Joined
Jun 26, 2017
Messages
26
Hi
I really need some help. This is the case:
I have a workbook with about 60 sheets and the number of sheets will change over time.
I would like to save selected sheets to 1 single PDF file, in the same place as the orginalfile with the same filename + with date and time stamp created.
I want the macro to loop trough all sheets in the workbook and if, for example A100 = “print” I want the sheet included In the PDF file report. When the file is saved a would like a msg box to appear with number of sheets saved.

Is this possible?
Can someone help me please, I am a very frustrated and I can’t fix the code myself and need some help

Thanks in advance
//Daniel
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Try this:
Code:
Public Sub Save_Sheets_As_PDF()

    Dim sheetsInPDF As Long
    Dim replaceSelected As Boolean
    Dim ws As Worksheet
    Dim p As Long, PDFfileName As String
    
    With ThisWorkbook

        sheetsInPDF = 0
        replaceSelected = True
        For Each ws In .Worksheets
            If LCase(ws.Range("A100").Value) = "print" Then
                ws.Select replaceSelected
                replaceSelected = False
                sheetsInPDF = sheetsInPDF + 1
            End If
        Next
            
        If sheetsInPDF > 0 Then
            p = InStrRev(.FullName, ".")
            PDFfileName = Left(.FullName, p - 1) & Format(Now, " yyyymmdd hhmmss") & ".pdf"
            .ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfileName, _
                Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            MsgBox "Created '" & PDFfileName & "' containing " & sheetsInPDF & " sheets"
        Else
            MsgBox "PDF file not created"
        End If
        
        .Worksheets(1).Select True
    
    End With
    
End Sub
 
Upvote 0
Wooow, Thanks John! The code is working very good and i am super duper happy and very impressed :LOL:

Best regards
//Daniel
 
Upvote 0
I'm pleased it works for you.

If you want a better quality PDF (but larger file size), change xlQualityMinimum to xlQualityStandard.
 
Upvote 0

Forum statistics

Threads
1,215,943
Messages
6,127,814
Members
449,409
Latest member
katiecolorado

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top