VBA - save as one PDF sheets selected in column based on sheets names

[Jorgi]

Dear All,
Thank you for adding me to the MREXCEL. Please help as I'm struggling to find solution for my excel problem. I'm looking for VBA code to save as one PDF selected sheets but the selected sheet names are listed in column so VBA needs to save as PDF sheets based on sheets names in that column. The sheets to print as PDF names will changes dynamically as an formula determines which sheets name has to be added to the list/column so one day can be 1sheet and second day can be 5sheets to be saved as PDF depends on data input. The range will have to be e.g. A2:A6 for macro to check what sheet needs to be save as PDF. there is also a possibility that all the sheets will have to be saved as PDF. If the macro can work this way then I will be able to assign the macro to printer icon/shape and then I will be able to save the sheets listed in the column as PDF. Thank you very much for any possible solutions.

 

[John_w]

See if this macro meets your requirements.

Public Sub Save_Sheets_As_PDF()

    Dim PDFfile As String
    Dim currentSheet As Worksheet
    Dim replaceFlag As Boolean
    Dim cell As Range
    
    PDFfile = ThisWorkbook.Path & "\Save Sheets.pdf"
    
    Set currentSheet = ActiveSheet
    With ActiveSheet
        replaceFlag = True
        For Each cell In .Range("A2:A6")
            If cell.Value <> vbNullString Then
                Worksheets(cell.Value).Select replaceFlag
                replaceFlag = False
            End If
        Next
        If Not replaceFlag Then
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfile, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            currentSheet.Select
            MsgBox "Created " & PDFfile
        Else
            MsgBox "No sheets specified in A2:A6"
        End If
    End With
    
End Sub

 

[Jorgi]

John_w - thank you very much for the code. It is exactly what I needed. Much appreciated. It will save me a lot of time.

 

[Jorgi]

Dear John_w - is there a possibility that your macro could save now all as separated PDF instead of one for all PDF with each PDF name being the tab name from the range so A.pdf, C.pdf and D.pdf? Thank you

 

[John_w]

is there a possibility that your macro could save now all as separated PDF instead of one for all PDF with each PDF name being the tab name from the range so A.pdf, C.pdf and D.pdf

Certainly:

Public Sub Save_Sheets_As_PDFs()

    Dim cell As Range

    For Each cell In ActiveSheet.Range("A2:A6")
        If cell.Value <> vbNullString Then
            Worksheets(cell.Value).ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & cell.Value & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        End If
    Next
    
End Sub

 

[Jorgi]

Marvellous!!! John_w you are my hero and the last question (I hope) what if I want to save all the files as xlsx instead of PDFs? Is it possible? Thank you so much

 

[John_w]

what if I want to save all the files as xlsx instead of PDFs?

Public Sub Save_Sheets_As_XLSXs()

    Dim cell As Range

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False  'suppress warning if .xlsx file already exists - file is replaced
   
    For Each cell In ActiveSheet.Range("A2:A6")
        If cell.Value <> vbNullString Then
            Worksheets(cell.Value).Copy
            ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & cell.Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook
            ActiveWorkbook.Close SaveChanges:=False
        End If
    Next
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
End Sub

 

[Jorgi]

Thank you John_w this is perfect.

I was thinking to use as name of the xlsx files data from B2:B6 instead of the sheets name in A2:A6 but
when I change this line
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & cell.Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook
to
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Range("B2:B6") & ".xlsx", FileFormat:=xlOpenXMLWorkbook
I'm getting error. The aim is to get 3 seprated xlsx files and each of them will have name from B2:B6 I'm not sure if this is achievable. Can you help with it please?