経緯
シートを分割するのがクソだるいのでつくりました。
ゴール
Sheet1にあるデータを、Sheet2で指定した分だけ、
こんな感じで複数シートに分割します。
データの準備
分割したいデータ
まず、分割元のシート（Sheet1）です。
一番左端に数値で示された団体キーがあり、昇順に並んでます。
団体キーの項目名が 0 ですが、あえてです。
0,ColumnData1,ColumnData2,ColumnData3,ColumnData4,ColumnData5,ColumnData6,ColumnData7,ColumnData8,ColumnData9
4321,hhhhh-1-1,hhhhh-2-1,hhhhh-3-1,hhhhh-4-1,hhhhh-5-1,hhhhh-6-1,hhhhh-7-1,hhhhh-8-1,hhhhh-9-1
4321,hhhhh-1-2,hhhhh-2-2,hhhhh-3-2,hhhhh-4-2,hhhhh-5-2,hhhhh-6-2,hhhhh-7-2,hhhhh-8-2,hhhhh-9-2
4321,hhhhh-1-3,hhhhh-2-3,hhhhh-3-3,hhhhh-4-3,hhhhh-5-3,hhhhh-6-3,hhhhh-7-3,hhhhh-8-3,hhhhh-9-3
4321,hhhhh-1-4,hhhhh-2-4,hhhhh-3-4,hhhhh-4-4,hhhhh-5-4,hhhhh-6-4,hhhhh-7-4,hhhhh-8-4,hhhhh-9-4
4321,hhhhh-1-5,hhhhh-2-5,hhhhh-3-5,hhhhh-4-5,hhhhh-5-5,hhhhh-6-5,hhhhh-7-5,hhhhh-8-5,hhhhh-9-5
111111,aaaaa-1-1,aaaaa-2-1,aaaaa-3-1,aaaaa-4-1,aaaaa-5-1,aaaaa-6-1,aaaaa-7-1,aaaaa-8-1,aaaaa-9-1
111111,aaaaa-1-2,aaaaa-2-2,aaaaa-3-2,aaaaa-4-2,aaaaa-5-2,aaaaa-6-2,aaaaa-7-2,aaaaa-8-2,aaaaa-9-2
111111,aaaaa-1-3,aaaaa-2-3,aaaaa-3-3,aaaaa-4-3,aaaaa-5-3,aaaaa-6-3,aaaaa-7-3,aaaaa-8-3,aaaaa-9-3
111111,aaaaa-1-4,aaaaa-2-4,aaaaa-3-4,aaaaa-4-4,aaaaa-5-4,aaaaa-6-4,aaaaa-7-4,aaaaa-8-4,aaaaa-9-4
111111,aaaaa-1-5,aaaaa-2-5,aaaaa-3-5,aaaaa-4-5,aaaaa-5-5,aaaaa-6-5,aaaaa-7-5,aaaaa-8-5,aaaaa-9-5
111111,aaaaa-1-6,aaaaa-2-6,aaaaa-3-6,aaaaa-4-6,aaaaa-5-6,aaaaa-6-6,aaaaa-7-6,aaaaa-8-6,aaaaa-9-6
111111,aaaaa-1-7,aaaaa-2-7,aaaaa-3-7,aaaaa-4-7,aaaaa-5-7,aaaaa-6-7,aaaaa-7-7,aaaaa-8-7,aaaaa-9-7
123456,ggggg-1-1,ggggg-2-1,ggggg-3-1,ggggg-4-1,ggggg-5-1,ggggg-6-1,ggggg-7-1,ggggg-8-1,ggggg-9-1
123456,ggggg-1-2,ggggg-2-2,ggggg-3-2,ggggg-4-2,ggggg-5-2,ggggg-6-2,ggggg-7-2,ggggg-8-2,ggggg-9-2
123456,ggggg-1-3,ggggg-2-3,ggggg-3-3,ggggg-4-3,ggggg-5-3,ggggg-6-3,ggggg-7-3,ggggg-8-3,ggggg-9-3
123456,ggggg-1-4,ggggg-2-4,ggggg-3-4,ggggg-4-4,ggggg-5-4,ggggg-6-4,ggggg-7-4,ggggg-8-4,ggggg-9-4
123456,ggggg-1-5,ggggg-2-5,ggggg-3-5,ggggg-4-5,ggggg-5-5,ggggg-6-5,ggggg-7-5,ggggg-8-5,ggggg-9-5
222222,bbbbb-1-1,bbbbb-2-1,bbbbb-3-1,bbbbb-4-1,bbbbb-5-1,bbbbb-6-1,bbbbb-7-1,bbbbb-8-1,bbbbb-9-1
222222,bbbbb-1-2,bbbbb-2-2,bbbbb-3-2,bbbbb-4-2,bbbbb-5-2,bbbbb-6-2,bbbbb-7-2,bbbbb-8-2,bbbbb-9-2
222222,bbbbb-1-3,bbbbb-2-3,bbbbb-3-3,bbbbb-4-3,bbbbb-5-3,bbbbb-6-3,bbbbb-7-3,bbbbb-8-3,bbbbb-9-3
333333,ccccc-1-1,ccccc-2-1,ccccc-3-1,ccccc-4-1,ccccc-5-1,ccccc-6-1,ccccc-7-1,ccccc-8-1,ccccc-9-1
333333,ccccc-1-2,ccccc-2-2,ccccc-3-2,ccccc-4-2,ccccc-5-2,ccccc-6-2,ccccc-7-2,ccccc-8-2,ccccc-9-2
333333,ccccc-1-3,ccccc-2-3,ccccc-3-3,ccccc-4-3,ccccc-5-3,ccccc-6-3,ccccc-7-3,ccccc-8-3,ccccc-9-3
333333,ccccc-1-4,ccccc-2-4,ccccc-3-4,ccccc-4-4,ccccc-5-4,ccccc-6-4,ccccc-7-4,ccccc-8-4,ccccc-9-4
333333,ccccc-1-5,ccccc-2-5,ccccc-3-5,ccccc-4-5,ccccc-5-5,ccccc-6-5,ccccc-7-5,ccccc-8-5,ccccc-9-5
444444,ddddd-1-1,ddddd-2-1,ddddd-3-1,ddddd-4-1,ddddd-5-1,ddddd-6-1,ddddd-7-1,ddddd-8-1,ddddd-9-1
444444,ddddd-1-2,ddddd-2-2,ddddd-3-2,ddddd-4-2,ddddd-5-2,ddddd-6-2,ddddd-7-2,ddddd-8-2,ddddd-9-2
444444,ddddd-1-3,ddddd-2-3,ddddd-3-3,ddddd-4-3,ddddd-5-3,ddddd-6-3,ddddd-7-3,ddddd-8-3,ddddd-9-3
444444,ddddd-1-4,ddddd-2-4,ddddd-3-4,ddddd-4-4,ddddd-5-4,ddddd-6-4,ddddd-7-4,ddddd-8-4,ddddd-9-4
555555,eeeee-1-1,eeeee-2-1,eeeee-3-1,eeeee-4-1,eeeee-5-1,eeeee-6-1,eeeee-7-1,eeeee-8-1,eeeee-9-1
555555,eeeee-1-2,eeeee-2-2,eeeee-3-2,eeeee-4-2,eeeee-5-2,eeeee-6-2,eeeee-7-2,eeeee-8-2,eeeee-9-2
555555,eeeee-1-3,eeeee-2-3,eeeee-3-3,eeeee-4-3,eeeee-5-3,eeeee-6-3,eeeee-7-3,eeeee-8-3,eeeee-9-3
555555,eeeee-1-4,eeeee-2-4,eeeee-3-4,eeeee-4-4,eeeee-5-4,eeeee-6-4,eeeee-7-4,eeeee-8-4,eeeee-9-4
666666,fffff-1-1,fffff-2-1,fffff-3-1,fffff-4-1,fffff-5-1,fffff-6-1,fffff-7-1,fffff-8-1,fffff-9-1
666666,fffff-1-2,fffff-2-2,fffff-3-2,fffff-4-2,fffff-5-2,fffff-6-2,fffff-7-2,fffff-8-2,fffff-9-2
実際のシート（Sheet1）はこんな感じ。
この左端の数値を次のSheet2で指定して、複数シートへ切り出します。
試すときは、新規ブック開いて、マクロ有効形式（.xlsm）で保存したら、
Sheet1に分割したいデータを貼り付けるなりインポートしておけばいいと思います。
切り出したい団体を指定
次に、指定する団体をSheet2に書いておきます。
CITY
4321
111111
123456
222222
333333
444444
555555
666666
実際のシート（Sheet2）のイメージはこんな感じ。
一部指定でもおｋ。
準備OK．
VBAの準備
最後にVBA。
Option Explicit
Sub Sheet1をSheet2と突合し分割()
'各マスタの行数・列数を取得
'CITYマスタの最終行数
Dim rowsSheet2 As Long
rowsSheet2 = Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
'DATAマスタの最終行数
Dim rowsSheet1 As Long
rowsSheet1 = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
'DATAマスタの最終列数
Dim colsData As Long
colsData = Sheet1.Cells(1, Columns.Count).End(xlToRight).Column
'突合ループ内で突合するDATAの範囲(開始位置)行数（初期値）
Dim searchRangeStart As Long
'DATAマスタの先頭
searchRangeStart = "1"
'突合ループ内で突合するDATAの範囲(終了位置)行数（初期値）
Dim searchRangeEnd As Long
'DATAマスタの最終行数
searchRangeEnd = rowsSheet1
'突合ループ
'突合ループ用変数宣言
Dim n As Long
Dim m As Long
'突合成功フラグ
Dim matchFlag As Integer
matchFlag = 0 '倒しておく
'突合範囲スタートエンド
Dim matchRangeStart As Long
Dim matchRangeEnd As Long
'CITYのはじめから終わりまで
For n = 2 To rowsSheet2
Sheet2.Select
Dim k As Long
k = Sheet2.Cells(n, 1).Value
'DATAのCITYごとの範囲で
For m = 1 To searchRangeEnd
Sheet1.Select
Dim l As Long
l = Sheet1.Cells(m, 1).Value
'CITYコードが一致
If k = l Then
'突合フラグが立ってなかったら、立てる（突合中CITYコードの最初のヒット）
If matchFlag = 0 Then
matchRangeStart = m
matchFlag = 1
End If
End If
'突合検索がDATA最終行まで到達
If m = searchRangeEnd Then
'直前までに突合していれば、
If matchFlag = 1 Then
'突合範囲を確定
matchRangeEnd = m
'新規ワークシートを開き、突合選択中のCITY名称を設定、オブジェクト指定する
Worksheets.Add
ActiveSheet.Name = Sheet2.Cells(n, 1).Value
Dim wsi As Worksheet
Set wsi = ActiveSheet
'作成したワークシートに突合範囲を行ごとコピーする
Sheet1.Range(matchRangeStart & ":" & matchRangeEnd).Copy wsi.Range("A1")
'フラグ倒す
matchFlag = 0
End If
End If
'CITYコードが不一致
If k < l Then
'直前までに突合していれば、
If matchFlag = 1 Then
'突合範囲を確定（一つ前の行迄）
matchRangeEnd = m - 1
'新規ワークシートを開き、突合選択中のCITY名称を設定、オブジェクト指定する
Worksheets.Add
ActiveSheet.Name = Sheet2.Cells(n, 1).Value
Dim wsj As Worksheet
Set wsj = ActiveSheet
'作成したワークシートに突合範囲を行ごとコピーする
Sheet1.Range(matchRangeStart & ":" & matchRangeEnd).Copy wsj.Range("A1")
'フラグ倒す
matchFlag = 0
End If
'DATAとの突合ループmを抜ける
Exit For
End If
Next m
Next n
End Sub
開発＞VisualBasicエディターから、標準モジュールに保存しておきます。
実行
そぉい！
結果
できました。
分割したシートはこんな感じ。
一部指定で実行したとき。
指定したものだけシート生成されてます。
やり直すときは、生成されたシートを削除して、Sheet1・Sheet2だけの状態に戻してから。
所感
うまくできたぽい。しらんけど！