エクセルVBAでの貼付け

質問

エクセルを使用してのVBAについてです。

VBA初心者です。行き詰ってしまったので、質問させてください。

「データワークシート」に下記のようなデータがあるとします。

　　　A　　　　B　　　　C　　　　　D
1　　国 　　 地域　　都道府県　　　都市　　　　　　　
2　　日本　　関東　　　東京　　　新宿区　　　
3　　日本　　関東　　　東京　　　渋谷区
4　　日本　　関東　 　神奈川　　 横浜市
5　　日本　　関東　 　神奈川　　 川崎市
6　　日本　　関東　 　神奈川　　 茅ヶ崎市

例えば、C列に「東京」とあったら、
D列のデータを「東京のワークシート」のC3から順に貼り付け、
「神奈川」だったらD列のデータを
「神奈川のワークシート」のC3から順に貼り付けるようなVBAを作成したいのですが、
ループを使用しようとしたのですが上手く出来ません。
ご回答よろしくお願いします。

回答No.2

imogasi · ベストアンサー

例データ
Sheet1　A1:D１２
国 地域 都道府県 都市
日本 関東 東京 新宿区
日本 関東 東京 渋谷区
日本 関東 神奈川 横浜市
日本 関東 神奈川 川崎市
日本 関東 神奈川 茅ヶ崎市
日本 中部 愛知県 名古屋市千種区
日本 中部 愛知県 常滑市
日本 中部 愛知県 豊田市
日本 近畿 大阪府 北区
日本 近畿 大阪府 中央区
日本 近畿 大阪府 豊中市
ーーー
重複の無い都道府県名リストをH列に作る。
操作で
データーフィルター
フィルタオプションの設定　で
「重複するレコードは無視する」をチェックして、で
H列に
都道府県
東京
神奈川
愛知県
大阪府
が出来る。VBAでも出来るが、操作にして、回答解説を複雑にしないことにする。
シートの数を府県名の数以上だけ増やしておく。
これもVBAで出来るが、回答解説を複雑にしないことにする。
ーー
コード　標準モジュールに
Sub test01()
Dim sh1
Set sh1 = Worksheets("Sheet1")
d = sh1.Range("H65536").End(xlUp).Row
For i = 2 To d '1行目は見出しなので省く
x = sh1.Cells(i, "H") 'H列の府県名を１つ取得
'--オートフィルタをかける
sh1.Range("A1").AutoFilter
sh1.Range("A:D").AutoFilter Field:=3, Criteria1:=x
'--オートフィルタをかけて、結果を書くシートにコピペ。見出し行込み
sh1.Range("A:D").SpecialCells(xlCellTypeVisible).Copy Worksheets(i).Range("a1")
sh1.Range("A:D").AutoFilter
Next i
End Sub
結果
例えば、Sheet3の神奈川県分は　A1:D４
国 地域 都道府県 都市
日本 関東 神奈川 横浜市
日本 関東 神奈川 川崎市
日本 関東 神奈川 茅ヶ崎市
シート名を府県名に変えるなら
sh1.Range("A:D").AutoFilter
の前の行に
Worksheets(i).Name = x
を入れると良い。
ーー
この課題は質問者に現状過ぎたもので、難しいかも。
色色なロジック（大筋の処理方法）が考えられるので、色々回答がありえる。
（１）フィルタ法（本件）
（２）ソート法（府県名で）ー１府県のセル範囲をまとめてコピペできる
（３）各行の府県に応じて、その都度に府県シートに書き込む方法（＃１のご回答はこれ？）
（４）コピー貼り付けか、セル代入法か
など。
ーー
マクロに記録が役立つが、私の回答は下記が下敷きになっている。
Sub Macro4()
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="東京"
Range("A2:D3").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Range("G2").Select
ActiveSheet.Paste
End Sub
こういうのが基本にあるのだ。質問者は、マクロの記録を取ることをやって考えたか。

お礼

回答ありがとうございます。
教えていただいたやり方は出来ました。
実際はデータ量がもっと多く、マクロの記録では
対処出来なかったので、質問させて頂きました。
ご指摘のとおり、自分のレベルが足りないので勉強して出直します。

ありがとうございました。

回答No.1

keithin

＞D列のデータを…C3から順に貼り付け、

東京シートや神奈川シートの１行目２行目にはタイトル行がキチンと記入済みだとします

作成例：
sub macro1()
　dim h
　worksheets("データワークシート").select

’上から順に値を転記していくだけ
　for each h in range("C2:C" & range("C65536").end(xlup).row)
　　on error goto errhandle
　　worksheets(h.value & "のワークシート").range("C65536").end(xlup).offset(1).value = h.offset(0, 1).value
　　on error goto 0
　next
　exit sub

’該当の対象シートがなければ新調する
errhandle:
　worksheets.add after:=worksheets(worksheets.count)
　activesheet.name:=h.value & "のワークシート"
　range("C2") = "title"
’あるいは
’worksheets("東京のワークシート").range("1:2").copy range("A1")
　resume
end sub

お礼

回答ありがとうございます。
おそらく自分の知りたいやり方に近いと思うので、
実際のデータに合わせて修正してやってみます。
ありがとうございました。