こんにちは!今回はエクセルマクロで一つのブック内のある複数のシートをそれぞれ別々のブックに保存してみようと思います。
エクセルマクロはとても便利な機能ですが、なかなか自分で作るとなるとハードルが高いものです。
ですが、一度作ってしまうと何度も使いまわしができるので非常に作業効率化になります。
今回のケースでは、月別などでシート管理しているようなエクセルの台帳を別々のブックにしたいときって結構あるなーと思ったので、それをテーマにマクロ化してみました。
このマクロを使ってもらえば、簡単かつスピーディにバラバラに保存することが出来ます。
※現在はマクロ経験者向けになっています。マクロの登録の仕方などは後でまとめたいと思います。
やりたいこと
・複数のシートで構成された1つのエクセルファイルをすべてシートごとに保存したい。
・マクロを実行して保存までやりたいので、シート名をファイル名にしてブック保存。
・一つだけ取り出すのではなく、全部バラバラに保存したい。
スクリプト例
Sub SplitSheets()
Dim i As Integer
Dim wb1, wb2 As Workbook
Dim Cnt As Integer
'1)シート数の取得
Set wb1 = ActiveWorkbook
Cnt = wb1.Sheets.Count
Dim CopyFileName
'EX)処理が止まらないようにダイヤログを抑制
Application.DisplayAlerts = False
For i = 1 To Cnt
'2)シート名でブックを作成
CopyFileName = ThisWorkbook.Path & "\" & wb1.Worksheets(i).Name & ".xlsx"
Workbooks.Add.SaveAs Filename:=CopyFileName
'3)元のブックのシートを先ほど作ったシート名のブックにコピー
Set wb2 = Workbooks(wb1.Worksheets(i).Name & ".xlsx")
wb1.Worksheets(i).Copy before:=wb2.Worksheets(1)
wb2.Worksheets(1).Name = wb1.Worksheets(i).Name
wb2.Worksheets("Sheet1").Delete
wb2.Close savechanges:=True
Next i
'EX)抑制したダイヤログ設定もとに戻す
Application.DisplayAlerts = True
End Sub
このマクロをバラバラに保存したいエクセルのマクロに登録して実行してあげれば、そのエクセルファイルの場所にずらずらっとシート名でファイルを分割してくれます。
解説
主要な部分を抜粋して説明していきたいと思います。
1)シート数の取得
まずは今開いているブックにあるシート数を取得します。
シート数はワークブックオブジェクトのプロパティである「sheets.count」で取得できます。
Set wb1 = ActiveWorkbook 今開いているブックをwb1としてオブジェクト作成 Cnt = wb1.Sheets.Count Sheets.Countプロパティを呼び出してシート数を取得
これによって処理しなくてはならない回数が分かります。
2)シート名でブックを作成
別のブックとして保存するには、「Workbooks.Add.SaveAs」メソッドを使うことで実現できます。名前を付けて保存の機能になります。
※この時作成されるのは新規ブックのため、「Sheet1」だけがあるだけのブックです。
名前を付けて保存というくらいですから、付けたい名前が必要になります。ここでは元のシート名が欲しいので、WorksheetsオブジェクトのNameプロパティで取得しています。
ThisWorkbook.Path & "\" & wb1.Worksheets(i).Name & ".xlsx" ThisWorkbook.Path 今開いているブックの場所を取得 wb1.Worksheets(i).Name i番目のシート名を取得
今回では、元のブックと同じ場所に保存したいので、「ThisWorkbook.Path」を使用しています。
そのため、ブック名とシート名が同じだと失敗するので注意してください。
直前のFor分でシートの数だけ繰り返すという処理を記述しているので、1~シートの最大枚数まで1ずつ「i」を足していきながら処理します。このときの「i」はシートのインデックス番号としての役割を果たします。
エクセルのシートはインデックス番号というもので管理されていて、1ページ目、2ページ目・・・といった具合で番号でもシートを指定できます。
そのため、「i」が1の時は1番目のシートの「.Name」を取得できるわけですね。
これを全シート分繰り返すため、それぞれシートごとにブックが作成されます。
3)元のブックのシートを先ほど作ったシート名のブックにコピー
次に作成したブックにシートをコピーしていきます。
まずは作ったブックを扱いやすいように「wb2」に取得します。原理は先ほどと同じくインデックス番号を使った方法で行います。
Set wb2 = Workbooks(wb1.Worksheets(i).Name & ".xlsx")
次にシートをコピーしていきます。「wb1」は元のブック、「wb2」はコピー先のブックになります。
wb1.Worksheets(i).Copy before:=wb2.Worksheets(1)
コピー先のブックに対して先頭にあるシートの前にコピーするように指定しています。
この場合は「.copy」に「before:」オプションを付けてあげます。この際の「Worksheets(1)」は先ほどのインデックス番号でいう一番左にあるシートの前ということなので、必然と先頭にコピーされます。
wb2.Worksheets("Sheet1").Delete wb2.Close savechanges:=True
最後にもとからあった「Sheet1」という名前」のついたシートを削除して保存して完了です。
この後「i」を1増やして最後のシートまで繰り返していきます。
これによってすべてのシートが別のブックに保存されていきます。
EX)処理が止まらないようにダイヤログを抑制
「Application.DisplayAlerts」は警告などダイヤログ表示を抑制する設定値です。
これが「True(有効)」のままですと、1ページ保存するごとに警告が表示されてしまいます。
すると毎回クリックが必要になってしまうため、今回は最後まで自動で行ってほしいので「False(無効)」に設定しました。
あとがき
今回は複数のシートで構成されたエクセルブックをシートごとにバラバラに保存するマクロを紹介させていただきました。
月別に管理していた台帳や、機種別にシート分けしたチェックシートなどいろんな場面でシート分けしたブックはでてきます。自分が作ったものじゃない場合、これを分解するのはつらいですよね。
SEの仕事をすると、意外にこの作業をやるケースは多いです。しかも手動でやると結構面倒です。
管理台帳なんかは大体このケースですし、なぜかピンポイントのシートをお客さんに出さねばならなかったり・・・。
やっぱりこういう繰り返し作業はマクロでやらせるのがベストでしょう。
ざっくりとした説明でしたので、わかりにくい部分もあったかもしれません・・・。
もし質問事項があればコメントしてくださいね♪
何かのお役に立てれば幸いです。
コメント
ご説明ありがとうございます。
10種類ほどのSheetを分けて保存したいのですが、
毎回、以下のの部分でつまずきます。
wb1.Worksheets(i).Copy before:=wb2.Worksheets(1)
上記の部分で”パス名が無効です” との表示が出て前に進みません。
理由が分からないのでご教示頂く事はできますでしょうか
コメントありがとうございます!
実際のワークシートを見るわけにはいかないため、推測にはなってしまいますが、元のシート名に「:」「?」「/」などのWindowsがファイル名に使用できない文字が入っているのではないでしょうか。
これらの文字が入っていると正常に保存できないために失敗することがあります。シンプルな文字だけのシート名に変更するとうまくいくかもしれません。
また、Excelが書き込みを行えない場所に保存されている(サーバー上やクラウド上、システムフォルダ内など)場合も同様のエラーが出たように記憶しています。
保存場所を変えてみるのも一つの手だと思うのでお試しください。
上手く動くことをお祈り申し上げます!
こんにちわ
早速、使わせていただいており、助かっています。
ただ、分割したファイルの保存場所を、元ファイルと別の場所(例えばD:\作業用)に
するにはどうしたらよいでしょうか?
下記の様に、保存場所を指定してみたのですが、うまく動きません。
根本的に考え方が間違っているのでしょうか?
ご教示頂けると幸いです。
すいませんが、よろしくお願いいたします。
‘2)シート名でブックを作成
‘ファイル保存先
Workbooks.Add.SaveAs Filename:=”D:\作業用” & “\” & wb1.Worksheets(i).Name & “.xlsx”
‘3)元のブックのシートを先ほど作ったシート名のブックにコピー
Set wb2 = “D:\作業用” & “\” & Workbooks(wb1.Worksheets(i).Name & “.xlsx”)
こんにちは!返信が遅くなってしまい申し訳ございません。
考え方はお間違えない様に思います。
おそらくWorkbooks.Add.SaveAsが分割した文字列を読めないのかもしれません。下記のように先にCopyFileName変数に格納してみるとうまくいくかもしれません。
CopyFileName = ”D:\作業用” & “\” & wb1.Worksheets(i).Name & “.xlsx”
Workbooks.Add.SaveAs Filename:=CopyFileName
後よくあるのは格納先フォルダがなかったりして失敗というケースでしょうか・・・。
現在Excelマクロを実行する環境がないので、確定的なことを言えなくてすいません。
お礼が遅くなってすいません。
なんとか出来ました!!
的確なアドバイスありがとうございます
さすがですね!!
ちょっとした事で動かないんですね~
大変、助かりました
どうもありがとうございました。
上手くいったようで何よりです^^
ほんとにちょっとしたことなんですよね、自分もよくハマります。
お役に立てたようでよかったですよ~