シート内の一部のセルを別シートにコピー

質問

Excelのマクロ(VBA)の記載方法について
お分かりになる箇所だけでも結構ですので、
どなたかご教授を願い致します。

シートX
　　A　　　　B　　　C　
1　data1　data2　data3
2　x　　　data7　data8
3　data4　data5　data6
4　data7　data8　data9

シート　Y
　　A　　　B　　　C　　　　D
1　length　３　　(任意)　(任意)
2　xxxx　(任意)　(任意)　(任意)
3　zzz　 (任意)　(任意)　(任意)
4　(空白)(任意)　(任意)　(任意)

上記のような２つのシート(同一Excelファイル内)があって、
シートXの一部のセルを次の条件(１～４)でシートYにコピーしたい場合

１．コピー元の列の数は、シートYの　"length"と書かれたセルの右となりの数字
　　とする(上記では３なので、A,B,C列をコピー対象）
２．コピー元の行の数は、シートXの１～４行目までとするが、
　　シートXのA列のセルが"x"だったら、その行は全てコピーしない。
３．コピー先(Y)の列は、コピー元(X)の列と一つずれてコピー(BならCに、CならDに)
４．コピー先(Y)の行は、シートYのA列で１行からで始めて空白セルになった行からコピー開始。
(上記では、A列で空白セルのある４行目からコピー)

上記条件で、下記のシートYを作成したいのですが、
この場合どようなマクロ(VBA)で実現できますでしょうか。

コピー結果(シートY)
　A　　　　　B　　　C　　　D
1　length　　３　　(任意)　(任意)
2　xxxx　　(任意)　(任意)　(任意)
3　zzz 　　(任意)　(任意)　(任意)
4　(空白)　data1　data2　data3
5　(任意)　data4　data5　data6
6　(任意)　data7　data8　data9

回答No.1

takibo · ベストアンサー

以下のようなコードでどうでしょうか。

Sub データコピー()
　列数 = Sheets("Y").Range("B1").Value
　貼付行 = Sheets("Y").Range("A65536").End(xlUp).Row + 1
　Sheets("X").Select
　j = 0
　　For i = 1 To 4
　　　If Sheets("X").Cells(i, 1).Value <> "x" Then
　　　　Sheets("X").Range(Cells(i, 1), Cells(i, 列数)).Copy Destination:=Sheets("Y").Cells(貼付行 + j, 2)
　　　　j = j + 1
　　　End If
　　Next
　Sheets("Y").Select
End Sub

お礼

出来ました！
ありがとうございます。