エクセルシートを個別にブック保存する連続処理

大量のシートを抱えたブックの全シートを、別々のブックにしたかった。
シート1枚目を残し、シート名をファイル名としてブック保存するだけ。

Sub ブック吐き出し()
    
    Dim strSaveFileName As String, strSavePath As String
    strSavePath = ThisWorkbook.Path & "\個別\"
    
    Application.ScreenUpdating = False '画面の更新を停止
    
    'エクセルシートの最後尾を別ブックに吐き出す
    With ThisWorkbook
        Do While .Sheets.Count <> 1
            strSaveFileName = .Sheets(.Sheets.Count).Name
            .Sheets(strSaveFileName).Move '新規ブックに移動してアクティブとなる
            ActiveWorkbook.SaveAs Filename:=strSavePath & strSaveFileName & ".xlsx"
            ActiveWindow.Close
        Loop
    End With
    
    Application.ScreenUpdating = True '画面更新再開
    
End Sub

ファイル保存時のエラー処理が必要。

以上。