VBA Print selected sheets individually as PDF with set up name and date

[Morty]

Hello all . I have workbook with 11 sheets, first one is "Summary" and the rest 10 are all identical and are used as template ready to fill and printout. I would like to print as PDF only selected active sheets individualy to seted up folder. I have found amazing macro, but my capabilities to adjust it to my needs are limited :D. The date format added to file name is desired, but I would need to change the core name accordingly to values in merged cell E15 & E13, see below. Momentaly the code prints only 1 selected sheet.

CODE SAMPLE

Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub

MY SHEET SAMPLE

Test.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L
1
2
3
4
5
6
7
8
9
10			Building:
11
12
13			Object number:
14
15			SO name:
16
17
18
19
20
21
List 11

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
C19:J30	Cell	does not contain a blank value	text	NO

Thank you all for your replies and I wish you nice rest of the day .

Sincerely,
Morty

 

[EFANYoutube]

One way would be to make sure there is a work in the name of the sheets that you want to export that is the same e.g. "June Export 21", "July Export 21" . . .
Then tell excel to only run the code with worksheets that have the string " Export " in the name like below

Sub DoEachOne()
    
    Dim sheet As Worksheet
    For Each sheet In ThisWorkbook.Sheets

        If sheet.Name Like "* Export *" Then

            PDF_WorkSheet sheet
        
        End If

    Next sheet

    SameDIR = False

End Sub

 

[Morty]

One way would be to make sure there is a work in the name of the sheets that you want to export that is the same e.g. "June Export 21", "July Export 21" . . .
Then tell excel to only run the code with worksheets that have the string " Export " in the name like below

Sub DoEachOne()
   
    Dim sheet As Worksheet
    For Each sheet In ThisWorkbook.Sheets

        If sheet.Name Like "* Export *" Then

            PDF_WorkSheet sheet
       
        End If

    Next sheet

    SameDIR = False

End Sub

And isnt possible to work around the ActiveWindow.SelectedSheets.PrintOut, like i use in this code

Option Explicit

Sub Tisk()
'Print all selected sheets

Range("A1:K48").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
    IgnorePrintAreas:=False

Range("A1").Select


End Sub

but just set the output to be PDF ? And make the loop for the part with seting the name in desired format ? Because everytime change the name of every used sheet would be more time consuming then just to print them and set filename manualy :D

 

[Morty]

Edit for my previous coment, yeah i solved it just by changing "For Each sheet In ThisWorkbook.Sheets" to "For Each sheet In ActiveWindow.SelectedSheets" in the:

Sub DoEachOne()

   
    Dim sheet As Worksheet
    For Each sheet In ActiveWindow.SelectedSheets

        If sheet.Name <> "Summary" Then

            PDF_WorkSheet sheet
       
        End If

    Next sheet

    SameDIR = False

End Sub

Someone could say, I am master hacker now :D :D (joke). Thank you for everything man and wish you the best .

 

[EFANYoutube]

Edit for my previous coment, yeah i solved it just by changing "For Each sheet In ThisWorkbook.Sheets" to "For Each sheet In ActiveWindow.SelectedSheets" in the:

Sub DoEachOne()

  
    Dim sheet As Worksheet
    For Each sheet In ActiveWindow.SelectedSheets

        If sheet.Name <> "Summary" Then

            PDF_WorkSheet sheet
      
        End If

    Next sheet

    SameDIR = False

End Sub

Someone could say, I am master hacker now :D :D (joke). Thank you for everything man and wish you the best .

Good to know its working. Always happy to help

 

[EFANYoutube]

My Code should have worked though, unless you have the macro in a different workbook to the one with the sheets you want to process

 

[Morty]

My Code should have worked though, unless you have the macro in a different workbook to the one with the sheets you want to process

Honestly I havent tested it. It can work. But you would need to manualy rename sheets you want to print everytime. And it would be exhausting :D