【VBA】シートを新規ブックとして保存する方法

Sub CopyToNewBook()
    '''アクティブシートを新規ブックへコピーして保存
    '''デフォルトのシートは削除する
    
    Dim actSht As Worksheet
    Set actSht = ActiveSheet
    
    ''ファイル名を取得
    Dim strFileName As String
    strFileName = InputBox("新規作成するExcelファイル名を入力してください")
    If StrPtr(strFileName) = 0 Then: Exit Sub
    
    ''保存フォルダパスを取得
    Dim strFldrPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = 0 Then: Exit Sub 'キャンセルされたときの処理
        strFldrPath = .SelectedItems(1)
    End With
    
    Dim sht_i As Long
    With Workbooks.Add
        actSht.Copy after:=.Sheets(.Sheets.Count) 'シート末尾に追加
        
        ''コピーシート以外を削除
        For sht_i = .Sheets.Count To 1 Step -1
            If sht_i <> .Sheets.Count Then .Sheets(sht_i).Delete
        Next
        
        .Sheets(.Sheets.Count).Name = actSht.Name 'sheet1(1)の場合を想定
        .SaveAs strFldrPath & "\" & strFileName & ".xlsx" 'ファイル保存
    End With
End Sub