一致するデータを複数シートから別のシートへ移動

質問

Sheet1～Sheet3を用いて、
Sheet1とSheet2でそれぞれのC列の項目が一致するデータを抽出し、
該当するデータの
Sheet1B列⇒Sheet3D1
Sheet2A列⇒Sheet3A1
Sheet2B列⇒Sheet3B1
Sheet2C列⇒Sheet3C1
に移動するためのマクロを組みたいと思っています。

Sheet2からSheet1に検索をかけて、
Sheet2C列≠Sheet1C列であればSheet2のA1行を削除していき
Sheet2C列＝Sheet1C列であれば
Sheet2A～C列をSheet3A～C列へ移動するところまでは出来ました。
※なお、Sheet3のA1行に文字列があればセルを1行追加する設定にしています。

しかし、それはA1行の文字列をそのままコピペしているだけなので
Sheet1B列の一致データをSheet3D1へ移動するやり方が思い浮かびません…。
Sheet2と同じくA1行を削除していこうとしてもうまくいきませんでした。

どんどんマクロも指示文ばかりが増えてわけが分からなくなってきてしまい、挫折しています。
シンプルにするにはどうすればいいでしょうか？

また、マクロの内容を載せたいのですが
会社の業務端末で組んでいるため転記できません；
申し訳ありませんが、どうかご指導ください。

回答No.3

tom04

こんにちは！
質問の意味を取り違えている可能性がありますが・・・

＞Sheet2C列≠Sheet1C列であればSheet2のA1行を削除していき

の部分の解釈ですが、削除ではなくSheet1のC列にSheet2のC列データがあればSheet3のA～C列に表示するという考えではダメですか？

この考え方のコードの一例です。

Sub test()
Dim i, j As Long
Dim ws1, ws2, ws3 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
Set ws3 = Worksheets("sheet3")
ws3.Cells.ClearContents
With ws3.Cells(1, 1)
.Value = ws2.Cells(1, 1)
.Offset(, 1) = ws2.Cells(1, 2)
.Offset(, 2) = ws2.Cells(1, 3)
.Offset(, 3) = ws1.Cells(1, 2)
End With
Application.ScreenUpdating = False
For i = 2 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To 3
If WorksheetFunction.CountIf(ws1.Columns(3), ws2.Cells(i, 3)) Then
ws3.Cells(Rows.Count, j).End(xlUp).Offset(1) = ws2.Cells(i, j)
End If
Next j
Next i
For j = 2 To ws3.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
If ws1.Cells(i, 3) = ws3.Cells(j, 3) Then
ws3.Cells(j, 4) = ws1.Cells(i, 2)
End If
Next i
Next j
Application.ScreenUpdating = True
ws3.Cells(1, 1).Select
End Sub

こんな感じではどうでしょうか？

＞※なお、Sheet3のA1行に文字列があればセルを1行追加する設定にしています。
がちょっと判断しかねますので、この件は無視しています。

的外れならごめんなさいね。m(__)m

回答No.2

keithin

訳の分からなくなった（＝正しくない）マクロを見せられて「これでワタシがシタイ事を想像してください」というクイズ形式では，親切な情報提供とは言えません。

具体的にどんなデータがあって，そこからアナタはどんな結果が欲しいと思っているのか，といった「あなたのお手元の事実」を正しく情報提供するよう心がけてみてください。例示が正しいかご自身で検証することで，ジブンが何をしたいと思っているのかの整理も付きますし，ご質問の書きぶりもきっともっと適正になっていきます。

で，どうも何をしたいのか不明なのが
＞Sheet1とSheet2でそれぞれのC列の項目が一致するデータを抽出し
→Ｃ列が同じかどうかを，「同じ行同士」で検査している？それとも「任意の行同士で検索して見つけたい？」どちらですか？

まぁ，ゴタクは置いておいて，とりあえずこんなカンジで試してみてください。
sub macro1()
　dim i as long
　for i = worksheets("Sheet2").range("C65536").end(xlup).row to 2 step -1
　if worksheets("Sheet2").cells(i, "C") = worksheets("Sheet1").cells(i, "C") then
　worksheets("Sheet3").range("2:2").insert
　worksheets("Sheet3").range("A2:C2").value = worksheets("Sheet2").cells(i, "A").resize(1, 3).value
　worksheets("Sheet3").range("D2").value = worksheets("Sheet1").cells(i, "B").value

　worksheets("Sheet2").cells(i, "A").entirerow.delete shift:=xlshiftup
　worksheets("Sheet1").cells(i, "A").entirerow.delete shift:=xlshiftup
　end if
　next i
end sub

回答No.1

mu2011

>Sheet2C列≠Sheet1C列であればSheet2のA1行を削除していき
　⇒このA1行を削除の意味が不明、補足説明をお願いします。
　私見です。
　　（１）Sheet2をSheet3へカット＆ペースト
　　（３）Sheet3のＣ列最終行からSheet1のＣ列をFind、見つかればSheet1のＢ列をコピー、
　　　　　無ければSheet3の該当行を削除
　という事でしょうか。