全シートを別々のブックとして保存するExcelマクロ

「vba すべてのシート 別々のファイル 保存 2010」
という検索で、このサイト・インストラクターのネタ帳へのアクセスがありましたので、いつものようにExcelマクロを作ってみました。

アクティブブックの全ワークシートを別々のブックとして新規フォルダーに保存するサンプルマクロ

以下のSubプロシージャを実行すると、アクティブなブックの存在するフォルダーに、ブック名と同じ名前のフォルダーが作成され、そのフォルダーにすべてのワークシートが、別々のブックとして保存されます。

サンプルマクロの解説

WorkbookオブジェクトのNameプロパティは、拡張子付きでブック名を返すので、拡張子なしのブック名を変数・bk_nameに代入しておきます。
　　Dim bk_name As String
　　bk_name = Left(bk.Name, InStrRev(bk.Name, ".") - 1)

その変数・bk_nameに代入した拡張子なしのブック名などを使って、作成するブックを保存するフォルダーを作成します。
　　Dim fol_path As String
　　fol_path = ActiveWorkbook.Path & "\" & bk_name & "\"
　　MkDir fol_path

この記事の元となった検索キーワード
「vba すべてのシート 別々のファイル 保存 2010」
に該当する処理はこのあとです。

アクティブなブックに含まれる全てのワークシートに対してFor Each～Nextループを回して、
　　Dim sh As Worksheet
　　For Each sh In bk.Worksheets

Worksheet.Copyメソッドで、新規ブックにワークシートを複製して、
　　　sh.Copy

アクティブになっている新規ブックを保存しています。
　　　With ActiveWorkbook
　　　　.SaveAs fol_path & sh.Name

引数なしでWorksheet.Copyメソッドを実行したときに、新規ブックを表すWorkbookオブジェクトを返してくれると良かったと思うのですが、そういうつくりにはなっていないので、

シートの複製直後には新規ブックがアクティブになっていることを利用して、ActiveWorkbookプロパティでアクティブなブックを表すWorkbookオブジェクトを取得して、SaveAsメソッドで保存しています。