Zapisywanie arkuszy na podstawie ich nazw

To makro prawie robi dokładnie to, czego potrzebuję, ale chciałbym, aby umieściło „_sspl.xlsx” na końcu każdej nazwy arkusza i umieściło pliki w folderze o tej samej nazwie, co oryginalna ścieżka do pliku.

Nie mogę tego zrobić poprawnie.

Sub CreateNewFolder()
Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim strFilename As String

    Set wbThis = ThisWorkbook.Name
    For Each ws In wbThis.Worksheets
        strFilename = wbThis.Path & "/" & ws.Name
        ws.Copy
        Set wbNew = ActiveWorkbook
        wbNew.SaveAs strFilename
        wbNew.Close
    Next ws
End Sub

„Nie mogę tego naprawić” nie jest najdokładniejszym opisem problemu :)

Poniższy kod nie został przetestowany (nie mam programu Excel na tym komputerze), ale myślę, że zrobi to, co chcesz.

Sub CreateNewFolder()
Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet 
Dim strFilename As String

Set wbThis = ActiveWorkbook
For Each ws In wbThis.Worksheets
    strFilename = wbThis.Path & "/" & ws.Name & "_sspl.xlsx"
    ws.Copy
    Set wbNew = ActiveWorkbook
    wbNew.SaveAs Filename:=strFilename
    wbNew.Close
Next ws

End Sub