Excel VBAでExcelシートを個別のブックに分割して保存する

Excel業務あるあるシリーズ。

複数のシートを独立したExcelファイルに分割して保存したい！！

ちまちまコピーして保存して・・・と手作業でやるのは効率が悪い！！

ということで今回は、Excelで、シートごとに別ブックに分割して保存するVBAの処理について紹介したいと思います。

Excel業務あるあるシリーズ

Excel VBAで差し込み印刷を実現する - 適材適所

Excel VBAで名前を指定してシートを大量に新規作成する - 適材適所

ExcelでQRコードを簡単に作成！！のはずが・・・PowerShellでQRコードを作成するはめになった話 - 適材適所

Excel VBAでシートの一覧を作成しハイパーリンクを作成して目次を作る - 適材適所

ExcelVBAで差し込み印刷もどきをやってみる - 適材適所

VBAでキーごとにシートに分ける簡単なサンプル - 適材適所

【Excel業務あるある】重複データから最大値or最小値を抽出する - 適材適所

シートを分割して個別のブックに保存したい

例えば、このようなブックがあるとします。

test.xlsm

ブックにSheet1～Sheet4の４つのシートがあります。

やりたいのは、各シートを個別のブックに分割して、このブックと同じフォルダに保存するということです。

この状態から・・・ こうしたい！！

これは、手作業は面倒！

しかも大体この手の作業は定期的にやらなければならないことが多かったりする・・・。

シートを分割して保存するコード

単刀直入に。

コードは次の通りです。

 

Sub saveSheet()
    Dim shObj As Worksheet
    Dim newBook As Workbook
    Dim newBookName As String
    Dim folderParent As String
    
    'シートの保存先はこのブックと同じとする
    '必要に応じてこの変数を変更する
    folderParent = ThisWorkbook.Path & "\"
    
    'ワークシートの分だけ繰り返す
    For Each shObj In Worksheets
        'シート名を変数に格納しておく
        newBookName = shObj.Name & ".xlsx"
        
        'シートを新しいブックにコピーする
        shObj.Copy
        '移動先のブックがアクティブになっているので変数に格納する
        Set newBook = ActiveWorkbook
        '新しいブックを名前を指定して保存する
        newBook.SaveAs folderParent & newBookName
        '新しいブックを閉じる
        newBook.Close
    Next shObj
End Sub

簡単な解説

上記のコードではブックの保存先として、下記の部分でtest.xlsmと同じフォルダを指定しています。

 

folderParent = ThisWorkbook.Path & "\"

ここを書き換えてあげることで、任意のフォルダに分割後のブックを保存することができます。

次にFor each でブック内のすべてのシートを処理します。

 

'シートを新しいブックにコピーする
shObj.Copy
'移動先のブックがアクティブになっているので変数に格納する
Set newBook = ActiveWorkbook

WorksheetsオブジェクトのCopyメソッドはその名の通り、シートをコピーします。

引数はbeforeかafter、つまりどのシートの前後にコピーするか指定できます。

何も指定しないと、新しいブックにコピーします。

ここでは新規ブックとして各シートを分割したいのでこの特性を利用します。

この部分のミソ、というか、Copyメソッドを使うときの常套手段かも。

Copy実行後はコピーして新しく作成されたブックがアクティブになる性質を利用して、

ActiveWorkBookを変数に格納してあげています。

本当はCopyメソッドがコピー後のWorksheetオブジェクトを返してくれれば話は早いんですがね・・・。

次は先ほどコピーしたブックを保存するところ。

 

'新しいブックを名前を指定して保存する
newBook.SaveAs folderParent & newBookName
'新しいブックを閉じる
newBook.Close

あとは、先ほどの新しく出来たブックのSaveAsメソッドを呼び出し、引数に保存先を指定してあげます。

これで１つのシートを保存することができました。

最後に今処理したブックを閉じるのをお忘れなく。

あとはFor eachですべてのシートに対して同様に処理が行われます。

直下のフォルダに保存するのではなくフォルダも新規作成したい！！

シートを分割して新しく作成したブックの保存先は元となるブックと同じところにしてありますが、そうではなくて別のフォルダに保存したい！なんてこともあるかも知れません。

例えば、月ごとにこの手の作業を行う必要があり、月別にフォルダを作成して保存したり、取引先ごとに保存したり・・・。

そんなときは先ほどのコードを少し改造してあげましょう。

保存先のフォルダも新規に作成するコード

先ほどのコードを一部修正して、保存先のフォルダも別々に新規作成するようにします。

 

Sub createFolderAndSaveSheet()
    Dim shObj As Worksheet
    Dim newBook As Workbook
    Dim newBookName As String
    Dim folderParent As String
    Dim folderName As String
    
    '保存先の親フォルダ。必要に応じてこの変数を変更する
    folderParent = ThisWorkbook.Path & "\"
    
    'ワークシートの分だけ繰り返す
    For Each shObj In Worksheets
        'シート名を変数に格納する
        newBookName = shObj.Name & ".xlsx"
        'フォルダ名を変数に格納する。ここではシート名と同じ名前のフォルダを作成している
        folderName = folderParent & shObj.Name
        'フォルダがないことを確認する
        If Dir(folderName, vbDirectory) = "" Then
            'フォルダを新規に作成する
            MkDir folderName
        End If
        '保存しようとしているブックと同じファイル名がないか確認
        If Dir(folderName & "\" & newBookName) = "" Then
             'シートを新しいブックにコピーする
            shObj.Copy
            '移動先のブックがアクティブになっているので変数に格納する
            Set newBook = ActiveWorkbook
            '新しいブックを名前を指定して保存する
            newBook.SaveAs folderName & "\" & newBookName
            '新しいブックを閉じる
            newBook.Close
        End If
    Next shObj
End Sub

簡単な解説２

修正した箇所について簡単に解説します。

 

'フォルダがないことを確認する
If Dir(folderName, vbDirectory) = "" Then
   'フォルダを新規に作成する。ここではシート名と同じ名前のフォルダを作成している
   MkDir folderName
End If
'保存しようとしているブックと同じファイル名がないか確認
If Dir(folderName & "\" & newBookName) = "" Then
  (以下略)

さきほどのコードとの違いは、Dir関数とMkdirステートメントでフォルダを操作しているところです。

Dir関数は引数に指定したパスが存在する場合、指定したパスと一致した最初のファイル名を戻り値として返すという、おもしろい関数です。

第二引数は定数を指定します。

vbDirectoryを指定すると一致するディレクトリ名を返してくれます。

これまた常套手段の一つですが、これらの性質を利用して、戻り値がブランクなら、「一致するものがない＝ファイルやフォルダが存在しない」と判断して、存在チェックを行っています。

また、さらっと登場するMkdirステートメントは、make directoryの略で、ディレクトリを作成します。

これでシートの数だけフォルダを作り、そこに新しく作成したブックを保存することができます。

結果

修正後のコードを実行すると、このようにフォルダができます！

個別のブックごとに新しく保存先のフォルダが作成され、その中にちゃんとシートが格納されていることが確認できました！

これは便利！

終わりに

Excel VBAでExcelシートを個別のブックに分割して保存する方法を紹介しました。

得意先ごとにシートを作って、作ったシートを新しいブックにコピーして、さらにそれをフォルダごとに仕分けして・・・

なんて作業、ありがちじゃないですか？

このコードを活用して、そんな作業は自動化しちゃってください！

そして余った時間で、他のあるあるシリーズもご覧いただき、

どんどん作業を自動化しちゃってください！

ちょっとしたことですが、誰かのお役に立てば。

ここまでお読みいただきありがとうございました。

もっとExcelのシートと戯れられそうな関連記事

www.tekizai.net

www.tekizai.net

www.tekizai.net