VBA コピペで使える！グループ毎でブック分割して指定フォルダに格納する方法

どうもマサヤです！

コード説明不要！サクッとコードだけ知りたい or 使いたい方向けの記事です。

※他のコピペで使えるは記事はこちら！

さて、今回は

このファイルのリストをクラス毎でブックに分割して、このフォルダにいれといて～。

あっリストの上にあるタイトルや注意文、あと、別シートも各ブックにそのまま残しておいてね

マサヤ

はい！わかりました！（どれどれ・・・えつ・・・うそ・・・グループが50個もあるやん！手作業でやるとめっちゃ時間かかる）

マサヤ

まぁ、でもVBAでやればすぐでしょ。

よし、ネットでコードを探して・・・・・・

マサヤ

あれ、データだけ分割するコードは見つかるのに、他のデータやシートをそのまま残して分割するコードが見つからない涙

と、いったことが程々ですが発生します）笑

データだけを分割するコードはよくあるんですが、他の情報を残してブック分割するコードがなかなか見当たらないですよね。

それならば自分で作る！ということでコーディングしました！

即効で作業終了させるためにサクッとコピペできるように紹介しますね！

【動画】コード実行した結果はこんな感じ

「思っていた形と違う！」と、なるといけないので動画でコードの実行結果をご覧ください。

動画では、クラス毎にブックを分割し「ファイル分割用」フォルダへ各ブックを保存しています。

分割されたブックには、分割したデータ以外は全てそのまま残っています。

【これをコピペ！】グループ単位でブック分割・フォルダ格納するコード

では、コードを紹介します。

Public myDic As Object
Sub SplitBook()

'分割したファイルを出力するフォルダを設定
splitToPath = "C:\Users\masay\Desktop\ファイル分割用\"
splitToName = "クラス成績表.xlsm" '分割ファイルの名前を設定
targetSheet = "マスタ"            '分割したいデータがあるシート名を指定
dataRow = 5                       '分割したいデータの始点行を指定
dataCol = 2                       '分割したいデータの開始列を指定
TargetCol = 2                     '分割ルールの列を指定。ここではクラス毎で分けたいため2列（B列）目を指定

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set wb = ThisWorkbook

masterBook = wb.Path & "\" & wb.Name

'分割数及び分割名を算出　※今回はクラスのため、A/B/Cの3つクラスでファイルを分割
Call GetSplitNames(wb, targetSheet, dataRow, dataCol, TargetCol)

For Each Item In myDic
    'ファイルコピー
    objFSO.copyFile masterBook, splitToPath & Item & splitToName
    
    'コピーしたファイル展開
    Workbooks.Open splitToPath & Item & splitToName
    
    '不要行削除
    Call CellsDeleteFast(dataRow, dataCol, Item)
    
    'ファイルを上書き保存して閉じる
    ActiveWorkbook.Close SaveChanges:=True
Next

End Sub
Sub GetSplitNames(wb, targetSheet, dataRow, dataCol, TargetCol)

Dim ws As Worksheet
Dim lastRow As Long
Dim varData As Variant

Set ws = wb.Worksheets(targetSheet)
Set myDic = CreateObject("Scripting.Dictionary")

lastRow = ws.Cells(Rows.Count, dataCol).End(xlUp).Row
varData = ws.Range(ws.Cells(dataRow + 1, TargetCol), ws.Cells(lastRow, TargetCol))

For Each Item In varData
    If Not Item = Empty Then
        If Not myDic.Exists(Item) Then
            myDic.Add Item, Null
        End If
    End If
Next

End Sub
Sub CellsDeleteFast(dataRow, dataCol, targetNum)

Dim ListLastRow As Long
Dim DeleteCells As Range
Dim ws As Worksheet

'対象シートは適時変更
Set ws = ActiveSheet
'A列を見て最終行を取得　リストがA列以外なら要変更
ListLastRow = ws.Cells(Rows.Count, dataCol).End(xlUp).Row
ListLastCol = ws.Cells(dataRow, dataCol).End(xlToRight).Column

'1行目は見出しとみなし、2行目から探査
For i = dataRow + 1 To ListLastRow
    'Rangeに削除対象行を格納　※今回は指定クラス名以外。
    If ws.Cells(i, dataCol) <> targetNum Then
        '初回のみ
        If DeleteCells Is Nothing Then
            Set DeleteCells = ws.Range(ws.Cells(i, dataCol), ws.Cells(i, ListLastCol))
        '2回目以降は追加
        Else
            Set DeleteCells = Union(DeleteCells, ws.Range(ws.Cells(i, dataCol), ws.Cells(i, ListLastCol)))
        End If
    End If
Next

'削除対象行が1つでもあれば行削除を実施
If Not DeleteCells Is Nothing Then DeleteCells.Delete (xlShiftUp)

End Sub

後述しますが、5～11行目箇所を状況に応じてファイル名や行列の設定をして利用します。

この後は使い方・解説コーナーとなりますので、利用方法が解る方は自分好みにカスタマイズして利用してください。

具体的なコードの使い方

コードの使い方を説明します！

まずはコードをコピー＆ペースト

まずは、VBE展開⇒標準モジュール追加⇒本コードコピペしましょう。

コピペ操作の流れ（動画有）はこちらで確認できます。（別コードをコピーしていますが操作は一緒です）

分割したいデータ（表）位置やファイル名を設定

コードコピーが終わったら、分割したいデータ表に合わせて5行目～11行目の設定を行います。

分割ブックの保存フォルダを設定

下記には、分割されたブックを保存するフォルダパスを指定します。

splitToPath = "C:\Users\masay\Desktop\ファイル分割用\" '分割したファイルを出力するフォルダを設定

分割で作成されるブック名を設定

分割されるブック名を指定します。

splitToName = "クラス成績表.xlsm" '分割ファイルの名前を設定

同じファイル名にならないように、ファイル名の手前にグループ毎の名前が自動付与されます。

今回の例でいうと、クラス毎で分割するため下記のようなファイル名でブックが作成されます。

分割データのあるシート名とデータの開始行・列を設定

分割したいデータ表があるシートを指定します。

targetSheet = "マスタ"            '分割したいデータがあるシート名を指定

次にデータ表の左上の行と列を指定します。

動画では5行目の2列から分割したいデータ表がありますよね。

dataRow = 5 '分割したいデータの始点行を指定
dataCol = 2 '分割したいデータの開始列を指定

データ表からグルーピングしたい列を設定

分割したいデータ表からまとめたい対象となる列を指定します。

例では2列目にあるクラスを指定し、同じクラスデータ毎でブック分割しています。

TargetCol = 2    '分割ルールの列を指定。ここではクラス毎で分けたいため2列（B列）目を指定

注意：データ表に空白行や列があったらエラー！

分割したいデータ表に空白があるとうまく分割できません。

データ表の左の列と一番上の行（見出し部分）に関しては必ずデータが連続となるようにしてください。

動画を例にすると、一番左の列はクラス、一番上の行は見出し部分（クラス・名前・点数）ですね。

コードの解説

では主要部分のコードを説明します。

独自関数：GetSplitNamesで分割するグループ数と名前を取得

ブック分割するためには事前に分割するグループ数と名前を知る必要があります。

今回を例にすると、「この表に3つのグループが存在して、そのグループ名はA・B・Cだよ！」というのは最初に把握しておく必要があり、そのための関数がGetSplitNamesになります。

コードの動きとしては、Dictionaryオブジェクトを使いデータ表のクラスを一つずつ確認してます。

Dictionaryに存在しないクラスをAddメソッドを使い格納するため、重複しないリストが完成します。

独自関数：CellsDeleteFastで指定グループ以外のデータを削除

Aクラスのブックを作る際、B・Cクラスデータを削除するための関数がCellsDeleteFastになります。

具体的には、データ表の不要部分だけを削除できるようセル範囲削除（上詰め）を行っています。

この関数は、下記記事のコードをカスタマイズしたものになります。

VBA・Excel 時短！コピペで使える複数行を高速に削除するコード

複数行を高速で削除するVBAコードを紹介します！ 表の中に不要な行がたくさんある・・・一つ一つ削除するのは面倒だ！確かに、手作業で消すと時間かかりますよね。 これ、どうぞ。コピペして使ってください。メッチャ速く削除できますよ。

mmm-program.com

2018.11.20

まとめ

グループに応じてブック分割するコードをご紹介しました。

データを集約して、また分割するといった時に大活躍するコードです。

ぜひ、あなたが同じことで困っているなら一度利用してみてくださいね！