振り分けて、別ブックの 「 同レコードの番号 」 に貼り付けるには？

質問

「　ブック1　」　の３つ （　変動あり　） の集合 （　上から空白セルを挟んで、集合1、集合2、集合3　）
を　「　ブック2　」　へ　　集合1　→　B列　　　　集合2　→　C列　　　　集合3　→　D列
と、　「　同レコードの番号　」　に貼り付けるには、どのようなコードになりますでしょうか？

（空白セルを入れたほうが、作業しやすいと私自身が思って、挿入しました。
また、2つのブックのA列の数字の最大値は　12　です。）

難しくて困っております。
何卒、ご教授願います。
------------------------
【ブック1】
A　　　　　B　　　　　C　　　　　D　　　
・　　　　　・　　　
・　　　　　・

8　　 ああ 　
7　　 ああ
4　　 ああ
3　　 ああ
1　　 ああ

12　　ああ
11　　ああ
4　　 ああ
2　　 ああ

10　　ああ
9　　 ああ
8　　 ああ
6　　 ああ
5　　 ああ　
----
【ブック2】
A　　　 B　　　　C　　　　D　　　　　E・・・　
1　　　ああ
2　　 　　 　　　ああ
3　　　ああ　　
4　　　ああ　　ああ 　　　
5　　 　　 　　　　　　　　ああ 　 　
6　　 　　 　　　　　　　　ああ 　　
7　　　ああ 　　 　
8　　　ああ　　　 　 　　 ああ　
9　　 　　 　　　　　　　　ああ
10　　 　　 　　　　　　　ああ
11　　 　　 　　ああ　
12　　 　　 　　ああ

回答No.1

NNAQ · ベストアンサー

「ブック2」のB1から貼り付けるとして、

Sub test()
Dim bk01 As Worksheet, bk02 As Worksheet
Dim r As Range
Dim i As Integer, j As Integer

Set bk01 = Workbooks("Book1.xls").Worksheets("Sheet1")
Set bk02 = Workbooks("Book2.xls").Worksheets("Sheet1")
Set r = bk01.Columns(1).SpecialCells(xlCellTypeConstants, 1)

For i = 1 To r.Areas.Count
With r.Areas(i)
For j = 1 To .Rows.Count
bk02.Cells(.Cells(j, 1).Value, i + 1).Value = .Cells(j, 2).Value
Next j
End With
Next i
End Sub

「ブック1」のA列に集合以外のデータがある場合は、
Set r = bk01.Columns(1)
の、Columnsを、Endを使うなり適宜変更して下さい。

お礼

質問内容を、一旦、撤回しようと思っておりました。
そして、何時間もかけて、「フィルタオプションの設定」で手作業にて４０％ぐらいがやっとでした。
一瞬、疑いました。
言葉は、見当たりません、どうもありがとうございました。