ExcelVBA データのコピー範囲について

質問

あけましておめでとうございます。今年もよろしくお願いします。

Sub Test()
Dim myTarget As Range, r As Range, f
Set myTarget = Sheets("Sheet1"). _
　　　Range("B2", Sheets("Sheet1").Range("B65536").End(xlUp))
For Each r In myTarget
　Set f = Sheets("Sheet2").Columns(1). _
　　　Find(r.Value, Sheets("Sheet2").Range("A1"), Lookat:=xlWhole)
　If Not f Is Nothing Then
　　　If r.Offset(0, 3).Value <> f.Offset(0, 3).Value Then
　　　　 f.Resize(1, 4).Copy Destination:= _
　　　　　Sheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0)
　　　End If
　End If
Next r
End Sub

前回の質問で教えていただいたコードなのですが、現時点では、B列のデータを元にして二つのSheetのデータを比較して別Sheetへコピーしているのですが、そのときに、B列以降の（たとえば、B列からX列まで）データはコピーできますが、A列もコピーしたい時はどうすればよいのかで、悩んでいます。どの様に変更すればよいのでしょうか？

回答No.5

ki-aaa · ベストアンサー

例示されたコードでは、結果が出なかったので
一部変更しています。

Sub Test()
Dim myTarget As Range, r As Range, f
Set myTarget = Sheets("Sheet1"). _
　　　Range("B2", Sheets("Sheet1").Range("B65536").End(xlUp))
For Each r In myTarget
　Set f = Sheets("Sheet2").Columns(2). _
　　　Find(r.Value, Sheets("Sheet2").Range("B2"), Lookat:=xlWhole)
'変更前　Set f = Sheets("Sheet2").Columns(1). _
'変更前　Find(r.Value, Sheets("Sheet2").Range("A1"), Lookat:=xlWhole)

　If Not f Is Nothing Then
　　　If r.Offset(0, 2).Value <> f.Offset(0, 2).Value Then
'変更前　If r.Offset(0, 3).Value <> f.Offset(0, 3).Value Then

　　　　 f.Offset(0, -1).Resize(1, 4).Copy Destination:= _
　　　　　Sheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0)
'回答個所　 f.Resize(1, 4).Copy

　　　End If
　End If
Next r
End Sub

お礼

細かい質問に答えていただき感謝いたします。
データもウマク動き大変感動しています。
ありがとうございました。

回答No.4

imogasi

元の質問は
http://okweb.jp/kotaeru.php3?q=1130032
ですよね。
例データは私が一部補充。
元のソースのままで実行してみました。
（Ｓｈｅｅｔ１）Ａ１：Ｄ４
コード 商品 店名 納入日
0360 メロン D店 1月4日
0001 みかん A店 1月3日
0112 きんかん C店 1月4日
（Ｓｈｅｅｔ２）Ａ１：Ｄ４
コード 商品 店名 納入日
0001 みかん A店 1月3日
0360 メロン D店 1月2日
0112 きんかん D店 2月11日
（結果）Ｓｈｅｅｔ３
0360 メロン D店 1月2日
0112 きんかん D店 2月11日
となり、Ａ列（＝コード）ももって来てますが。
私の勘違いなら済みません。

お礼

なんだか、私の質問の仕方が悪いようなので、もう一度書きます。
（Ｓｈｅｅｔ１）Ａ１：Ｄ４
入力日　区画　コード 商品 店名 納入日
1/1　　　1　　　0360 メロン D店 1月4日
3/2　　　1　　　0001 みかん A店 1月3日
3/3　　　3　　　0112 きんかん C店 1月4日
（Ｓｈｅｅｔ２）Ａ１：Ｄ４
入力日　区画　コード 商品 店名 納入日
3/2　　　1　　　0001 みかん A店 1月3日
1/1　　　1　　　0360 メロン D店 1月2日
3/3　　　3　　　0112 きんかん D店 2月11日
（結果）Ｓｈｅｅｔ３
1/1　　　1　　　0360 メロン D店 1月2日
3/3　　　3　　　0112 きんかん D店 2月11日

という状況に変わったので、Ｃ列のコードが一致する行の納入日を比較して結果を出したいのですが、現在の
　　　If r.Offset(0, 3).Value <> f.Offset(0, 3).Value Then
　　　　 f.Resize(1, 4).Copy Destination:= _
　　　　　Sheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0)
　　　End If
のままだとＣ列より左側のデータがコピーされないので困っています。どのように書き直すのが良いのでしょうか？

回答No.3

happypoint

まちがっちゃった。
Set myTarget = Sheets("Sheet1"). _
　　　Range("E2", Sheets("Sheet1").Range("B65536").End(xlUp))

だね。

回答No.2

happypoint

Set myTarget = Sheets("Sheet1"). _
　　　Range("B2", Sheets("Sheet1").Range("B65536").End(xlUp))

が
Set myTarget = Sheets("Sheet1"). _
　　　Range("A2", Sheets("Sheet1").Range("B65536").End(xlUp))

になるんでないの？

アドバイスだけど、
こういう質問のときは、前回の質問の番号を出した方がいいよ。

回答No.1

happypoint

f.Resize(1, 4).Copy Destination:= _
を
f.Resize(0, 4).Copy Destination:= _
でどうですか？

誰に教えてもらったコードなの？
綺麗なコードだね。

補足

ありがとうございます。
すみません、もしE列を比べて、A-D列もコピーの場合はどうなるんでしょう？？