マクロ有効ブックをマクロなしブックとして同じブック名で同一階層に保存

' この処理はアクティブブックの全シート名を配列に格納し、新規ブックにまとめてコピーします。
' その後、新規ブックをマクロなしのファイルとして保存します。

Sub prcCopySheetsToNewWorkbookAndSave()
    Dim wbkSource As Workbook ' 元のワークブック
    Dim wbkNew As Workbook ' 新しいワークブック
    Dim arrSheets() As String ' シート名を格納する配列
    Dim intSheetCount As Integer ' シートの総数
    Dim i As Integer ' ループカウンタ
    Dim strNewPath As String ' 新しいファイルのパス
    Dim fso As FileSystemObject

    Set wbkSource = ActiveWorkbook
    Set fso = New FileSystemObject
    intSheetCount = wbkSource.Sheets.Count
    ReDim arrSheets(1 To intSheetCount)

    ' シート名を配列に格納
    For i = 1 To intSheetCount
        arrSheets(i) = wbkSource.Sheets(i).Name
    Next i

    ' 新規ブックを作成し、シートをまとめてコピー
    Set wbkNew = Workbooks.Add
    wbkSource.Sheets(arrSheets).Copy Before:=wbkNew.Sheets(1)

    ' 最初に自動で作成されるシートを削除
    Application.DisplayAlerts = False
    wbkNew.Sheets(1).Delete
    Application.DisplayAlerts = True

    ' 新しいファイルのパスを設定
    strNewPath = fso.GetParentFolderName(wbkSource.FullName) & "\" & fso.GetBaseName(wbkSource.FullName) & ".xlsx"
    
    ' マクロなしの形式で保存
    wbkNew.SaveAs Filename:=strNewPath, FileFormat:=xlOpenXMLWorkbook
    wbkNew.Close

    Set fso = Nothing
    
    MsgBox "終了"
End Sub