適材適所

PowerShellやVBAなどプログラミング系の話多めで

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

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

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

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

ということで今回は、シートごとに分割して保存するVBAについて紹介したいと思います。

Excel業務あるあるシリーズ

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

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

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

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

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

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

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

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

test.xlsm

f:id:shinmai_papa:20200916215110p:plain

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

やりたいのは、各シートを個別のブックに分割して

このブックと同じフォルダに保存するということです。

この状態から・・・ f:id:shinmai_papa:20200916215114p:plain こうしたい!!

f:id:shinmai_papa:20200916215117p:plain

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

単刀直入に。

コードは次の通りです。

 
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メソッドを呼び出し、

引数に保存先を指定してあげます。

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

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

あとは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

簡単な解説2

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

さきほどのコードとの違いは、

Dir関数とMkdirステートメントでフォルダを操作しているところです。

Dir関数は引数に指定したパスが存在する場合、

指定したパスと一致した最初のファイル名を戻り値として返す、

おもしろい関数です。

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

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

これまた常套手段の一つですが、

これらの性質を利用して、

戻り値がブランクなら、

一致するものがない=ファイルやフォルダが存在しない

として、存在チェックを行っています。

さらっと登場するMkdirステートメントは、

make directoryの略で、ディレクトリを作成します。

これでシートの数だけフォルダを作り、

そこに新しく作成したブックを保存することができます。

結果

上記のコードを実行すると、

このようにフォルダができます。

f:id:shinmai_papa:20200916215121p:plain

新しくフォルダが作成され、

中に、ちゃんとシートが格納されていることが確認できます。

f:id:shinmai_papa:20200916215125p:plain

終わりに

得意先ごとにシートを作って、作ったシートを新しいブックにコピーして、

さらにそれをフォルダごとに仕分けして・・・

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

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

そして余った時間で、他のあるあるシリーズも読んでもらい、

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

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

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

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

www.tekizai.net

www.tekizai.net

www.tekizai.net