VBA Creates Folder based on cell reference and saves excel workbook sheets to individual PDF for each folder

[BcoxSLC]

The following code creates folders in the current file path based on a cell reference for each worksheet in a workbook and then saves the worksheet to the folder by the same name. I have been trying unsuccessfully to export each worksheet as a pdf instead of saving it as an excel file. I am an admitted novice. Any advice is to modify the code is much appreciated; or do I need to start over for what I'm trying to achieve?

Public Sub TESTSaveShtsToPDF()
Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
Dim theFilePath As String
MyFilePath$ = ActiveWorkbook.Path & ""
For Each Sheet In ActiveWorkbook.Worksheets
SheetName$ = Sheet.Range("c3").Value
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' End With
On Error Resume Next '<< a folder exists
theFilePath = MyFilePath & SheetName
MkDir theFilePath
With Sheet
.Select
.Copy
ActiveWorkbook.SaveAs Filename:=theFilePath & "" & SheetName & ".xlsx", FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
End With
.CutCopyMode = False
End With
Next Sheet
End Sub

 

[DanteAmor]

Try :

Public Sub TESTSaveShtsToPDF()
    Dim Sheet As Worksheet, SheetName$, MyFilePath$
    Dim theFilePath As String
    MyFilePath$ = ThisWorkbook.Path & "\"
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For Each Sheet In Sheets
        SheetName$ = Sheet.Range("c3").Value
        On Error Resume Next '<< a folder exists
        theFilePath = MyFilePath & SheetName
        MkDir theFilePath
        On Error GoTo 0
        
        Sheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=theFilePath & "\" & SheetName & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next Sheet
End Sub

 

[BcoxSLC]

Thank you for such a quick response. It doesn't pull an error, but it doesn't create the folders or PDF anywhere that I can see.

Try :

Public Sub TESTSaveShtsToPDF()
    Dim Sheet As Worksheet, SheetName$, MyFilePath$
    Dim theFilePath As String
    MyFilePath$ = ThisWorkbook.Path & "\"
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For Each Sheet In Sheets
        SheetName$ = Sheet.Range("c3").Value
        On Error Resume Next '<< a folder exists
        theFilePath = MyFilePath & SheetName
        MkDir theFilePath
        On Error GoTo 0
        
        Sheet.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=theFilePath & "\" & SheetName & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next Sheet
End Sub

 

[DanteAmor]

Have you already saved the file with the macro?
You only have one file open, right? it must be the file with the macro.


Check the first sheet, you must have a data in cell C3.
Tell me exactly what data you have in cell C3?

 

[BcoxSLC]

I thank you so much for your help. I really appreciate it - and now I see what has happened. It's saving the files in the same path as the Personal Macro Workbook. It didn't do that before, previously it would save them to the same folder as the open file.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.


Change this

MyFilePath$ = ThisWorkbook.Path & "\"

By :

MyFilePath$ = ActiveWorkbook.Path & "\"

 

[BcoxSLC]

Success! Thank you so much ... this made my day and will be quite useful for work.

 

[DanteAmor]

Im glad to help you and thanks for the feedback.