Home » エクセルマクロ・Excel VBAの使い方 » Workbookオブジェクト » 全シートを別々のブックとして保存するExcelマクロ

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

対象:Excel2010, Excel2013, Windows版Excel2016

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

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

[スポンサードリンク]

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

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


Sub アクティブブックの全ワークシートを別々のブックとして新規フォルダーに保存する()
 Dim bk As Workbook
 Set bk = ActiveWorkbook

 Dim bk_name As String
 bk_name = Left(bk.Name, InStrRev(bk.Name, ".") - 1)

 Dim fol_path As String
 fol_path = ActiveWorkbook.Path & "\" & bk_name & "\"
 MkDir fol_path

 Dim sh As Worksheet
 For Each sh In bk.Worksheets
  sh.Copy ' ワークシートを新規ブックに複製
  With ActiveWorkbook
   .SaveAs fol_path & sh.Name
   ' .Close
  End With
 Next sh
End 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オブジェクトを返してくれると良かったと思うのですが、そういうつくりにはなっていないので、

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

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

[スポンサードリンク]

Home » エクセルマクロ・Excel VBAの使い方 » Workbookオブジェクト » 全シートを別々のブックとして保存するExcelマクロ

TrackBack:0

TrackBack URL

Home » エクセルマクロ・Excel VBAの使い方 » Workbookオブジェクト » 全シートを別々のブックとして保存するExcelマクロ

「Workbookオブジェクト」の記事一覧

検索


Copyright © インストラクターのネタ帳 All Rights Reserved.

.