VBAコードで自ブックから配布用に複数ブックを生成する

1つのワークシート上にある全社の会計レコードから、各部配布用のブックに分割・集計するVBAサンプルコードをご紹介します。実務では古いデータの最新化を、取りまとめ部門から、各部署に依頼するケースがあります。

その際、取りまとめ部門が管理している全社レコードを、各部門に最新化してもらうために、いったん各部ごとのブックへ分割・集計した上で配布します。本記事では各部門へ配布するブックは、配布される部以外のレコードを取り除いた集計結果を配布するサンプルをご紹介します。

通常はその後、各部から最新化された複数のブックを回収し、再び1つの全社レコードとして合算集計します。

まずは本記事でご紹介するサンプルファイルの内容と、実行ビフォアアフターが分かる1分動画をご確認ください。

Tips
VBAで開かれた複数ブックのレコードを1つのブックに集計する

VBAで1つのブックから複数ブックへ展開するサンプルファイル

まずはサンプルファイルを用意しましたので、宜しければダウンロードしてくださいね。なお下のファイルは、97-2003形式です。

Sample-Excel-File-for-Deployment ダウンロード

サンプルシートは、とある会社の会計データで、全社分のレコードが入力されています。この全社レコードから、VBAを使い各部のデータを取り出して各部ごとに別ブックへデータを展開して集計します（下図）。

展開・集計された各部のブックは、それぞれの部門のレコードだけが入力されています。また、作成される5つのブックは、サンプルファイルと同じフォルダに作成されます。

VBAで1つのブックから5つのブックへ展開して集計させるサンプルコード

ではサンプルコードの紹介になります。余裕のある方はぜひ真似して書いてみてください。

Option Explicit

Sub VBAで各部配布用ブックに展開する()
    Application.ScreenUpdating = False

    Dim wbkSelf As Workbook                                             '自ブック用
    Dim wbkDept As Workbook, wstDept As Worksheet, lngERow As Long      '各部ブック用
    
    Dim strDept As String   '部門名称
    
    Dim r As Long
    Dim i As Integer
    
    Set wbkSelf = ThisWorkbook
    
    '5部に配布するブックを作成する
    For i = 1 To 5
        wbkSelf.Worksheets(1).Copy              '自ブックのシートを新しいブックへコピー
        Set wbkDept = ActiveWorkbook            '新規ブックをオブジェクト変数に設定
        Set wstDept = wbkDept.Worksheets(1)     '新規ブックの1枚目のワークシートを変数設定
        
        '繰り返し回数によって部門名称を分岐
        Select Case i
            Case 1: strDept = "人事部"
            Case 2: strDept = "開発部"
            Case 3: strDept = "生産部"
            Case 4: strDept = "品質部"
            Case 5: strDept = "営業部"
        End Select
        
        wstDept.Name = strDept                  'ワークシート名を部門名に変更
        
        '自ブックからコピーした全部門のレコードから、部門のデータ以外を削除
        With wstDept
            lngERow = .Range("A" & .Rows.Count).End(xlUp).Row   '対象レコード最終行番号取得
        
            For r = lngERow To 2 Step -1                'レコード削除処理なので最終行番号から先頭レコードへ処理
                If .Cells(r, 4) <> strDept Then         '処理対象部門名以外の場合
                    .Cells(r, 1).EntireRow.Delete       'レコード削除
                End If
            Next
        End With
        
        wbkDept.SaveAs ThisWorkbook.Path & "\" & strDept    '自ブックと同じフォルダに各部門用ブックを保存
        wbkDept.Close                                       '部門別ブックを閉じる
    Next
End Sub

Option Explicit

Sub VBAで各部配布用ブックに展開する()

Application.ScreenUpdating = False

Dim wbkSelf As Workbook '自ブック用

Dim wbkDept As Workbook, wstDept As Worksheet, lngERow As Long '各部ブック用

Dim strDept As String '部門名称

Dim r As Long

Dim i As Integer

Set wbkSelf = ThisWorkbook

'5部に配布するブックを作成する

For i = 1 To 5

wbkSelf.Worksheets(1).Copy '自ブックのシートを新しいブックへコピー

Set wbkDept = ActiveWorkbook '新規ブックをオブジェクト変数に設定

Set wstDept = wbkDept.Worksheets(1) '新規ブックの1枚目のワークシートを変数設定

'繰り返し回数によって部門名称を分岐

Select Case i

Case 1: strDept = "人事部"

Case 2: strDept = "開発部"

Case 3: strDept = "生産部"

Case 4: strDept = "品質部"

Case 5: strDept = "営業部"

End Select

wstDept.Name = strDept 'ワークシート名を部門名に変更

'自ブックからコピーした全部門のレコードから、部門のデータ以外を削除

With wstDept

lngERow = .Range("A" & .Rows.Count).End(xlUp).Row '対象レコード最終行番号取得

For r = lngERow To 2 Step -1 'レコード削除処理なので最終行番号から先頭レコードへ処理

If .Cells(r, 4) <> strDept Then '処理対象部門名以外の場合

.Cells(r, 1).EntireRow.Delete 'レコード削除

End If

End With

wbkDept.SaveAs ThisWorkbook.Path & "\" & strDept '自ブックと同じフォルダに各部門用ブックを保存

wbkDept.Close '部門別ブックを閉じる

End Sub

書き終わりましたら、VBAを実行してみてください。実行したファイルと同じフォルダに人事部、開発部、生産部、品質部、営業部の5つのブックが作成されましたでしょうか。ブックの中のシートも確認してみてくださいね。

VBAで1つのブックから5つのブックを生成させるアルゴリズム

ではVBAコードの解説にうつりますね。

6行目： Dim wbkSelf As Workbook
14行目： Set wbkSelf = ThisWorkbook
全社レコードがある自ブックの変数宣言と設定になります。

7行目： Dim wbkDept As Workbook, wstDept As Worksheet, lngERow As Long
VBAコードにより生成される5部門のブックに関する変数の宣言をしています。

9行目： Dim strDept As String
部門名称を保持する変数を宣言しています。

VBAコードの繰り返し処理によって各部ブックを生成するアルゴリズム

17～46行目： For i = 1 To 5 ～ Next
5部門のブックをこの繰り返し処理により生成します。変数iが1から5までとなっているのは、繰り返し1回につき1部門のブックを生成するからです。

ではここから繰り返し処理の中身について、1つの部門のブックを生成するまでの工程を図を使いながら詳しく説明しますね。

18行目： wbkSelf.Worksheets(1).Copy
まずは自ブックの全社シートを、新しいブックにコピーするVBAコードです。このVBAコード実行後のイメージは、下図右側のシートに示すように新規ブック「Book1」として作成されます。シートは全社シートと同じものがコピーされています。

19行目： Set wbkDept = ActiveWorkbook
20行目： Set wstDept = wbkDept.Worksheets(1)
コピーしたばかりの新規ブックは、アクティブであることを利用して、VBAコード19行目でワークブックオブジェクト変数「wbkDept」に設定しています。

さらにVBAコード20行目で、その新規ブックの1枚目のワークシート（コピーされた全社データシート）をワークシートオブジェクト変数「wstDept」に設定しています。

23～29行目：Select Case i ～ End Select
繰り返し回数用変数 i の値を、Select文の条件式にしています。変数 iの取る値に応じた部署名を変数「strDept」に代入しています。

31行目： wstDept.Name = strDept
VBAコード23～29行目で決まった変数「strDept」の文字列を、部門別シートのシート名に代入しています。言い換えると、このVBAコードシート名を部門名に変えています。

VBAで全社レコードから部門レコードを抽出するアルゴリズム

VBAコード35行目から41行目までにかけて、全社レコードから各部レコードを抽出しています。実は抽出と言っていますが、不要な部門のレコードを削除しています。

35行目： lngERow = .Range("A" & .Rows.Count).End(xlUp).Row
まずは全社レコードの状態ですので、行削除をする前に全社レコードの最終行番号を取得します。

37～41行目： For r = lngERow To 2 Step -1 ～ Next
VBAによる行削除は、最終行番号から繰り返し処理を開始します。そして、If文の判定条件により、削除する条件を満たすレコードを行削除していきます。

If文の条件判定による行削除のアルゴリズムについては、下図を参照してください。下の例はi=1「人事部」のときで、人事部以外の部署はThen以降で行削除されます。

そして、繰り返し処理が終わると下図赤枠のように人事部だけのレコードになります。

VBAコードで新規ブックを部名称で保存し閉じるアルゴリズム

44行目： wbkDept.SaveAs ThisWorkbook.Path & "\" & strDept
新規ブック「wbkDept」を名前を付けて保存するVBAコードになります。「.SaveAs」は、この場合Workbookオブジェクトのメソッドになり、「.SaveAs」に続けて保存するファイル名をフルパスで指定します。

なお、「ThisWorkbook.Path」は、「実行中のVBAコードが記述されている自ブックのフルパス」という意味になります。つまり、この場合はVBAを実行している自ブックと同じフォルダに、各部門のブックを保存することになります。

ファイル名は、部門名を保持する変数「strDept」で指定しています。またこのVBA実行後のイメージは、下図赤枠で示すように部門名で保存したのと同じです。

45行目： wbkDept.Close
繰り返し処理の最後に、生成された部門のブックを閉じて次の部門のブックを作成するための繰り返し処理にうつります。

まとめ

全社レコードをもつ自ブックのVBAコードにより、各部門へ配布するための各部用ブックを生成するサンプルコードをご紹介しました。

実務でもよく見かける、各部へのヒアリング用シートや、個人へのアンケートシートなどでは、その宛先別にブックを用意して配布しますよね。今回のVBAサンプルコードを応用すれば、全体レコードから各部、もしくは各個人宛用ブックを簡単に展開できます。

VBAでブック上の全社レコードを各部配布用ブックに分割する