Как экспортировать несколько листов и сохранить их в новой созданной папке с тем же названием, что и в книге

Question

Попытка экспортировать рабочие листы в pdf с циклом и сохранить их во вновь созданной папке, папка имеет то же имя, что и активная рабочая книга.Код работал в предыдущем файле, но теперь он больше не будет зацикливаться или сохраняться в новой папке.Он создает папку и экспортирует активный лист в PDF-файл.

Когда я запускаю его, я получаю ошибку времени выполнения 5, но только когда я запускаю его как цикл

Я уже пробовал разные имена файлов (active workbook.path & "\" &) и разными способамисоздать новую папку (MkDir)

Sub ExportAsPDFAndSaveInNewFolder()

    Dim wbA     As Workbook
    Dim wsA As Worksheet
    Dim tdate As String

    Dim fso As Object
    Dim fldrName As String
    Dim fldrpath As String

    Dim myFile  As String

    Dim CF As Long, CV As Long, RF As Long, RV As Long
    Dim Col As Long, Rw As Long
    Dim path As String

    Dim response As VbMsgBoxResult

    ' Set WS_Count equal to the number of worksheets in the active workbook.
    Set wbA = ActiveWorkbook
    Set wsA = ActiveSheet
    tdate = "Dec"

    'create new folder
    Set fso = CreateObject("scripting.filesystemobject")
        fldrName = wbA.name
        fldrpath = ActiveWorkbook.path & "\" & Left(wbA.name, InStr(wbA.name, "."))
        If Not fso.folderexists(fldrpath) Then
        fso.createfolder (fldrpath)
        End If

    ' Begin the loop.
    For Each wsA In wbA.Sheets
        wsA.Activate

         'create a default name for saving file
          myFile = "R Ch - S " & Year(Date) & " YTD " & tdate & " " & ActiveSheet.name & ".pdf"

            if wsA.name <> "Top 25" and wsA.name <> "Top 10" then
              ActiveSheet.ExportAsFixedFormat _
                        Type:=xlTypePDF, _
                        Filename:=**ActiveWorkbook.path & "\" & myFile, _**
                        (Filename:= fldrpath & myfile, _)
                        Quality:=xlQualityStandard, _
                        IncludeDocProperties:=True, _
                        IgnorePrintAreas:=False, _
                        OpenAfterPublish:=False
                With ActiveSheet
    CF = .Cells.Find(What:="*", After:=Range("A1"), 
         LookIn:=xlFormulas, _
         LookAt:=xlPart, SearchOrder:=xlByColumns,
         SearchDirection:=xlPrevious).Column
    CV = .Cells.Find(What:="*", After:=Range("A1"), 
         LookIn:=xlValues, _
         LookAt:=xlPart, SearchOrder:=xlByColumns, 
         SearchDirection:=xlPrevious).Column
    RF = .Cells.Find(What:="*", After:=Range("A1"), 
         LookIn:=xlFormulas, _
         LookAt:=xlPart, SearchOrder:=xlByRows,
         SearchDirection:=xlPrevious).Row
    RV = .Cells.Find(What:="*", After:=Range("A1"),
         LookIn:=xlValues, _
         LookAt:=xlPart, SearchOrder:=xlByRows,

         SearchDirection:=xlPrevious).Row

                   Col = Application.WorksheetFunction.Max(CF, CV)
                   Rw = Application.WorksheetFunction.Max(RF, RV)

                   .PageSetup.Orientation = xlLandscape
                   .PageSetup.Zoom = False
                   .PageSetup.FitToPagesTall = False
                   .PageSetup.FitToPagesWide = 1
                   .PageSetup.PrintArea = "$A$1:" & Cells(Rw, Col).Address
                End With
            End if

         Next wsA
    response = MsgBox(prompt:="PDF's created and saved", Buttons:=vbOKOnly, Title:="Exported to PDF and saved in new folder")