Print specific sheets seperately to printer and PDF

[vlacombe]

Is this doable and could someone suggest a script?

(Script would need to be seperate)

1. Print sheets seperately without prompt to the default printer: only if the sheet contains the text: "PrixMax" "6po" "Quote" (Then print them, else ignore)

2. Create a PDF per sheet (If sheet contains the text: "PrixMax" "6po" "Quote" Then create a PDF for each, else ignore) without prompt (like using the microsoft print to PDF "printer" even though it's not the default printer, and send the file(s) and to a specific path written in the script... like a folder on the desktop. Script can use the sheet name as file name and I would want it to overwrite the PDF file if one is existant.

 

[DanteAmor]

Try this

Sub Print_sheets()
  Dim sh As Worksheet, i As Long, shs As Variant
  Application.ScreenUpdating = False
  shs = Array("PrixMax", "6po", "Quote")
  For Each sh In Sheets
    For i = 0 To UBound(shs)
      If LCase(sh.Name) Like "*" & LCase(shs(i)) & "*" Then
        sh.PrintOut Copies:=1
        sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & sh.Name & ".pdf", OpenAfterPublish:=False
        Exit For
      End If
    Next
  Next
End Sub

 

[vlacombe]

Dante! You again

It works like a charm. I needed 2 seperate script but I manage to seperate both based on your example :D
What if I wanted to save each sheets as a different excel file with the exact same critera? (File name can be exactly like the pdf files but with .xls extension)

It should look exactly like your suggested script but I need to replace these 2 highlighted lines by??

Sub Print_sheets()
Dim sh As Worksheet, i As Long, shs As Variant
Application.ScreenUpdating = False
shs = Array("PrixMax", "6po", "Quote")
For Each sh In Sheets
For i = 0 To UBound(shs)
If LCase(sh.Name) Like "*" & LCase(shs(i)) & "*" Then

sh.PrintOut Copies:=1
sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "" & sh.Name & ".pdf", OpenAfterPublish:=False

Exit For
End If
Next
Next
End Sub

 

[DanteAmor]

Try this

sh.copy
    ActiveWorkbook.SaveAs Filename:= [COLOR=#333333]ThisWorkbook.Path & "\" & sh.Name & ".[/COLOR]xls", _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.close false

Note: The above is for versions of Excel 2007 or higher

 

[vlacombe]

Hi again Dante,

Some of the cells in the sheets I want to save refers to another sheet cell's value
Would it be possible to save the sheet without considering the formula but take the formula output as straigh up value?

Also when using your script, I'm always getting a pop up for compatibility checker. It warns me that some function might not be compatible with earlier versions of excel...
I'm aware of that but I would prefer it it doesn't ask me... I'm using the latest office 365

After that It pops another screen about excel version...

Here's the 2 screens:
https://i.imgur.com/OkOnXZj.png
https://i.imgur.com/ReINW5R.png

Can these 2 be avoided?

 

[DanteAmor]

Do you want the file as xls or xlsx?

After this line

[COLOR=#333333]Application.ScreenUpdating = False[/COLOR]

Add this line:

[COLOR=#333333]Application.DisplayAlerts = False[/COLOR]

 

[vlacombe]

Dante, my mistake

I do not need an older extension version... only the latest... I just assumed excel are xls too quickly
My files are indeed .xlsx and it is what I want

 

[DanteAmor]

Then try this

Sub Print_sheets()
  Dim sh As Worksheet, i As Long, shs As Variant
  Application.ScreenUpdating = False
[COLOR=#0000ff]  Application.DisplayAlerts = False[/COLOR]
  shs = Array("PrixMax", "6po", "Quote")
  For Each sh In Sheets
    For i = 0 To UBound(shs)
      If LCase(sh.Name) Like "*" & LCase(shs(i)) & "*" Then
[COLOR=#0000ff]         sh.copy[/COLOR]
[COLOR=#0000ff]         ActiveWorkbook.SaveAs Filename:= ThisWorkbook.Path & "\" & sh.Name & ".xlsx"        [/COLOR]
[COLOR=#0000ff]         ActiveWorkbook.close false[/COLOR]

        Exit For
      End If
    Next
  Next
End Sub

 

[vlacombe]

Hello Dante, thanks a lot for your support

The script works flawlessly. But only 1 issue remain as I mentionned above
many cells in the Excel file saved seperately refers to a value of another sheet from the previous notebook

for instance:
='[CALCULETTE-TEMPLATESEMIFINAL.xlsm]Prix-6po-2019'!B7

Now the issue I have is if I move my seperate save (saved by the script) elsewhere on my drive or the network, it might not be able to reach the path of "CALCULETTE-TEMPLATESEMIFINAL.xlsm"

Is there a work around in the script to save the excel file without taking into account any link to external sheets or workbook but save only the return value of the formula and not the formula refering to another sheets
All the concerned cells are from I21 to I45, although few cells in between aren't referring to any formula or return value from other sheets, but are just plain text or empty with borders and styles. Would you need to know only the specific concerned cells?

Can we do something about this?

Thank you

 

[DanteAmor]

Try this

Sub Print_sheets()
  Dim sh As Worksheet, i As Long, shs As Variant, w2 As Workbook, sh2 As Worksheet
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  shs = Array("PrixMax", "6po", "Quote")
  For Each sh In Sheets
    For i = 0 To UBound(shs)
      If LCase(sh.Name) Like "*" & LCase(shs(i)) & "*" Then
        sh.Copy
        Set w2 = ActiveWorkbook
        Set sh2 = w2.Sheets(1)
        sh2.Cells.Copy
        sh2.Range("A1").PasteSpecial xlPasteValues
        w2.SaveAs Filename:=ThisWorkbook.Path & "" & sh.Name & ".xlsx"
        w2.Close False
        Exit For
      End If
    Next
  Next
End Sub