Excel VBA 各シートを別々の新規ブックに保存する

スポンサーリンク
スポンサーリンク

各シートを別々のブックに保存する方法

「Excel」では、シート見出しを右クリックして「シートの移動またはコピー」メニューで移動先ブック名に「新しいブック」を選択して「コピーを作成する」のチェックボックスにチェックを入れれば、既存のシートの複製を新規ブックに作成できますがブック名を付けたり、シート名と同じブック名があると既存のブックを上書き保存してしまうリスクがあったりして
少し面倒です。また。複数のシートを別々の新規ブックにコピーする場合などは一度にできないので、大変時間がかかります。

ここでは、各シートがあるブックと同じ名前のフォルダを作成して、そのフォルダの中に各シートをシート名をブック名として各シートを別々の新規ブックに保存するコードをご紹介します。

分割したいシートが含まれているブックの「標準モジュール」に下記のコードを記述して、マクロを実行してください。

各シートを別々の新規ブックに保存するコード

Sub シート分割()
Dim 対象シート As Worksheet
Dim ファイル名 As String
Dim パス名 As String
 ファイル名 = ThisWorkbook.Name
 ファイル名 = Left(ファイル名, Len(ファイル名) - 5)
 パス名 = ThisWorkbook.Path & "¥" & ファイル名
If Dir(パス名, vbDirectory) = "" Then
 MkDir パス名
End If
 ChDir パス名
 Application.ScreenUpdating = False
For Each 対象シート In Worksheets
 対象シート.Copy
 ActiveWorkbook.SaveAs ActiveSheet.Name & ".xlsx"
Next
 Application.ScreenUpdating = True
 Application.Quit
 ThisWorkbook.Close False
End Sub

コードの解説

2行目【 Dim 対象シート As Worksheet 】
ブックに存在するシートを格納する変数「対象シート」をオブジェクト型(Worksheet)で宣言します。


3行目【 Dim ファイル名 As String 】
新規の作成するフォルダの名前に使うブックの名前を格納する変数「ファイル名」を文字列型(String)で宣言します。


4行目【 Dim パス名 As String 】
ブックのパス名(場所)を格納する変数「パス名」を文字列型(String)で宣言します。


5行目【 ファイル名 = ThisWorkbook.Name 】
Application【アプリケーション】オブジェクトのThisWorkbook【ディスワークブック】プロパティでこのブックを参照してName【メーム】プロパティでこのブックの名前を取得して変数「ファイル名」に代入します。


6行目【 ファイル名 = Left(ファイル名, Len(ファイル名) – 5) 】
文字列の左から指定した文字数分の文字列を取り出すLeft【レフト】関数を使用して変数「ファイル名」に格納されている文字列の文字数を文字列の長さを取得するLen【レン】関数で文字列の数を取得し、変数「ファイル名」に格納されているファイル名の拡張子部分(.xlsm)5文字分を減算して拡張子の無いファイル名を取得して変数「ファイル名」に改めて代入します。


7行目【 パス名 = ThisWorkbook.Path & “¥” & ファイル名 】
Application【アプリケーション】オブジェクトのThisWorkbook【ディスワークブック】プロパティで、このWorkbook【ワークブック】オブジェクトを参照してPath【パス】プロパティを使用してこのブックのパス(保存場所)を取得し、変数「ファイル名」に格納されている拡張子が無いファイル名を文字列を連結するアンパサンド「&」で連結して変数「パス名」に代入します。


8行目【 If Dir(パス名, vbDirectory) = “” Then 】
If【イフ】ステートメント(条件分岐)を使用して、条件式としてDir【デレクトリ】関数の第二引数をvbDirectoryにして変数「パス名」と同じ名前のフォルダーがないか探します。Dir【デレクトリ】関数の戻り値が長さ0文字の文字列「””」と等しいときを定義します。つまり変数「パス名」に格納されている「パスとファイル名」と同じフォルダーが存在しない場合を定義します。


9行目【 MkDir パス名 】
8行目の条件分岐が成立したら、すなわちパス名と同じ名前のフォルダがなかった場合に新規フォルダーを作成するMKDir【メイクデレクトリ】ステートメントで変数「パス名」に格納されている名前すなわち、このブック名でフォルダを作成します。


11行目【 ChDir パス名 】
ChDir【チェンジデレクトリ】ステートメントは、現在のフォルダ(カレントフォルダ)を指定した名前のフォルダにする関数です。指定した名前のフォルダが無い場合はエラーになります。ここでは、カレントフォルダを変数「パス名」に格納された名前のフォルダに指定しています。


12行目【 Application.ScreenUpdating = False 】
Application【アプリケーション】オブジェクトのScreenUpdating【スクリーンアップディーティング】プロパティにFalseを設定して、処理の高速化のために画面更新を抑止します。


13行目【 For Each 対象シート In Worksheets 】
For Each【フォーイーチ】ステートメントを使用して変数「対象シート」にワークシートを格納します。ワークシートの枚数分の
繰り返し処理になります。


14行目【 対象シート.Copy 】
繰り返し処理の中で変数「対象シート」に格納されたブックのシートを順番にコピーします。


15行目【 ActiveWorkbook.SaveAs ActiveSheet.Name & “.xlsx” 】
Workbook【ワークブック】オブジェクトのSaveAs【セーブアズ】メソッドを使用してコピーしたシート名の新たなブックを作成して
保存します。SaveAs【セーブアズ】メソッドはブックへの変更を別の新規ブックに保存するメソッドです。


16行目【 Next 】
ここまで、13行目のFor Eathステートメントの繰り返し処理です。シートの枚数分繰り返し シートをコピーして新しいブックを作成してブック名のフォルダに保存しています。


17行目【Application.ScreenUpdating = True 】
高速化のために抑止していた画面更新を再開します。


18行目【Application.Quit 】
Application【アプリケーション】オブジェクトのQuit【クイット】メソッドで「Excel」の終了を予約します。


19行目【ThisWorkbook.Close False 】
このワークブックをClose【クローズ】メソッドで閉じます。False【フォールス】を指定することで保存しないで閉じるになります。
※18行目でQuit(クイット)メソッドを実行しているので「他のエクセルブック」が開いていたらそのブックも保存しないで閉じてしまうのでこのマクロを実行する前に「他のエクセルブック」は閉じてください。


以上で、各シートを別々の新規ブックに保存する方法の解説を終了します。
ありがとうございました。

スポンサーリンク
スポンサーリンク

フォローする

スポンサーリンク
スポンサーリンク