Create PDF for Multiple sheets

[ashani]

Hi everyone,

I have a spreadsheet with 20 worksheets in it. Everytime user completes any worksheets, the worksheet name comes through IF Formula to the admin sheet. I want to create PDF for whichver worksheets name are in the range from A1:A20. The "home" sheet is default pdf so hence the below code but not sure how to create PDF from the sheet names in the range. Please can someone guide me.

Many thanks

Sub pdf_sh()
  Dim i As Long, c As Long
  Dim sheetarray() As String
  Dim pdfName As String, fileSaveName As Variant
  Dim default As Variant
 
  default = Array("Home")
 
  With Sheets("Home")
    pdfName = .Range("B9").Value & "_" & .Range("B17")
    ChDir "Test"
    fileSaveName = Application.GetSaveAsFilename(pdfName, "PDF Files (*.pdf), *.pdf")
    If fileSaveName <> False Then
      Sheets(sheetarray()).Select
      ActiveSheet.ExportAsFixedFormat xlTypePDF, fileSaveName, xlQualityStandard, True, False, , , True
      .Select
    End If
  End With
End Sub

 

[John_w]

Assuming every cell in A1:A20 has a sheet name in it, change the Select line to Sheets(Application.Transpose(.Range("A1:A20").Value)).Select

 

[ashani]

Thanks @John W
I tried it but it's not working and giving me error messages and the select line is highlighted. Here is the code :

Sub pdf_sh()
  Dim i As Long, c As Long
  Dim sheetarray() As String
  Dim pdfName As String, fileSaveName As Variant
  Dim default As Variant
 
    default = Array("Summary")
 
  With Sheets("Summary")
    pdfName = .Range("H17").Value & "_" & .Range("C27")
    ChDir "M:\"
    fileSaveName = Application.GetSaveAsFilename(pdfName, "PDF Files (*.pdf), *.pdf")
    If fileSaveName <> False Then
      Sheets(sheetarray()).Sheets(Application.Transpose(.Range("G38:G40").Value)).Select
      ActiveSheet.ExportAsFixedFormat xlTypePDF, fileSaveName, xlQualityStandard, True, False, , , True
      .Select
    End If
  End With
End Sub

 

[ashani]

sorry this is the code i'm using and it saysing subscription out of range.

Sub pdf_sh()
  Dim i As Long, c As Long
  Dim sheetarray() As String
  Dim pdfName As String, fileSaveName As Variant
  Dim default As Variant
    
    default = Array("Summary")
    
    With Sheets("Summary")
    pdfName = .Range("H17").Value & "_" & .Range("C25")
    ChDir "test"
    fileSaveName = Application.GetSaveAsFilename(pdfName, "PDF Files (*.pdf), *.pdf")
    If fileSaveName <> False Then
    ActiveSheet.ExportAsFixedFormat xlTypePDF, fileSaveName, xlQualityStandard, True, False, , , True
    Sheets(Application.Transpose(.Range("G38:G49").Value)).Select
    End If
  End With
End Sub

 

[ashani]

Assuming every cell in A1:A20 has a sheet name in it, change the Select line to Sheets(Application.Transpose(.Range("A1:A20").Value)).Select

Hi John,
I tried to go as far as I can - however the sheet name will only appear if user use that sheet otherwise it will show "None". So when I try to run the code its coming up subscription out of range - which is quite rightly as there're no sheets with the name of "None" - how can I ignore them and only select anything else other than None.

 

[ashani]

anyone please guide me on this. thank you

 

[John_w]

Hi John,
I tried to go as far as I can - however the sheet name will only appear if user use that sheet otherwise it will show "None". So when I try to run the code its coming up subscription out of range - which is quite rightly as there're no sheets with the name of "None" - how can I ignore them and only select anything else other than None.

As I said, my change requires all the cells to contain a sheet name.

With your further clarification, try this macro. Check/change the code, as it still looks at cells A1:A20, and B9 and B17 for the PDF file name, but this time on the "Summary" sheet as that's what you seem to be using now.

Public Sub Save_Sheets_As_PDF()

    Dim currentSheet As Worksheet
    Dim replaceFlag As Boolean
    Dim cell As Range
    Dim pdfName As String, fileSaveName As Variant
  
    With Worksheets("Summary")
        Set currentSheet = ActiveSheet
        replaceFlag = True
        For Each cell In .Range("A1:A20")
            If cell.Value <> "None" Then
                Worksheets(cell.Value).Select replaceFlag
                replaceFlag = False
            End If
        Next
        If Not replaceFlag Then
            pdfName = .Range("B9").Value & "_" & .Range("B17")
            ChDir "Test"
            fileSaveName = Application.GetSaveAsFilename(pdfName, "PDF files (*.pdf), *.pdf")
            If fileSaveName <> False Then
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fileSaveName, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            End If
            currentSheet.Select
        Else
            MsgBox "All sheets are 'None'"
        End If
    End With
  
End Sub

 

[ashani]

Hey John,
You're amazing - thank you so much.
Works like a dream.