エクセル VBA 複雑な行列入れ替えコピー

質問

VBAを使って複雑な行と列を入れ替えをしたいのですが？どなたか伝授していただけませんでしょうか？
　　　A　　　　B　　　　C
1　東京都　　ペット　マルチーズ
2　神奈川県　ペット　チワワ
3　埼玉県　　ペット　柴犬
4　千葉県　　ペット　プードル
　・
　・
　・
1,000行あります。

これを
別シートに20行づつ1行にまとめて
東京都　ペット　マルチーズ　神奈川県　ペット　チワワ　・・・
のようにしたいのです。
コピー先のデータ行数は元が1,000行だったので、結果50行になります。
よろしくお願いします。

回答No.1

fumufumu_2006 · ベストアンサー

Sub test()
Dim ss As Worksheet
Dim ds As Worksheet
Dim r As Integer
Set ss = Sheets("sheet1")
Set ds = Sheets("sheet2")
ds.Cells.Clear
For r = 1 To 1000
ds.Cells(((r - 1) \ 20) + 1, ((r - 1) Mod 20) * 3 + 1) = ss.Cells(r, 1)
ds.Cells(((r - 1) \ 20) + 1, ((r - 1) Mod 20) * 3 + 2) = ss.Cells(r, 2)
ds.Cells(((r - 1) \ 20) + 1, ((r - 1) Mod 20) * 3 + 3) = ss.Cells(r, 3)
Next
End Sub
とか
Sub test()
Dim ss As Worksheet
Dim ds As Worksheet
Dim r As Integer
Set ss = Sheets("sheet1")
Set ds = Sheets("sheet2")
ds.Cells.Clear
For r = 1 To 1000
ss.Cells(r, 1).Resize(1, 3).Copy ds.Cells(((r - 1) \ 20) + 1, ((r - 1) Mod 20) * 3 + 1)
Next
End Sub
でどうでしょう。

VBAを使わなくても、元シートをSheet1とすると、別シートのA1を指定します。
A1=OFFSET(Sheet1!$A$1,(ROW()-1)*20+INT((COLUMN()-1)/3),MOD(COLUMN()-1,3),1,1)
これをBH50の範囲に張り付ける。

p.s.
>複雑な行と列を入れ替え
となっているので、これではなかったら、すみません

お礼

ありがとうございます！
感動です！出来ました！これで、残業せずに家族の下へ真っ直ぐ帰れます！！！
fumufumu_2006さん、本当にありがとうございました。