ブック間のデータ転送マクロをお教えください

質問

Book1のSheet1のA列にあるデータと、開いているBook2のSheet2のA列にあるデータが完全一致したら、後者のBCD列のデータを前者のDEF列に順に代入するマクロをお教えください。
同じBook内にあるSheet1とSheet2間のデータ転送は、以下のFind関数を使用したマクロでうまくいのですが、Book間での処理に苦慮しています。できれば以下のコードを基にして作りたいです。よろしくお願い申し上げます。

--------

Sub sample()
転送先 = "D"　'転送先の列番号
転送元 = 1 '転送元の列番号（相対）
サイズ = 2 '転送サイズ

Set st1 = Worksheets("sheet1")
Set st2 = Worksheets("sheet2")
For i = 1 To st1.Cells(Rows.Count, 1).End(xlUp).Row
Set pos = st2.Range("A:A").Find(st1.Cells(i, "A"), _
LookAt:=xlWhole, MatchCase:=True, MatchByte:=True)
If Not pos Is Nothing Then
st1.Cells(i, 転送先).Resize(1, サイズ).Value = _
pos.Offset(0, 転送元).Resize(1, サイズ).Value
End If
Next
End Sub

回答No.1

keithin · ベストアンサー

ん？

Sub sample()
転送先 = "D"　'転送先の列番号
転送元 = 1 '転送元の列番号（相対）
サイズ = 3 '転送サイズ

Set st1 = workbooks("Book1.xls").Worksheets("sheet1")
Set st2 = workbooks("Book2.xls").Worksheets("sheet2")
For i = 1 To st1.Cells(Rows.Count, 1).End(xlUp).Row
Set pos = st2.Range("A:A").Find(st1.Cells(i, "A"), _
LookAt:=xlWhole, MatchCase:=True, MatchByte:=True)
If Not pos Is Nothing Then
st1.Cells(i, 転送先).Resize(1, サイズ).Value = _
st2.cells(pos.row, "B").Resize(1, サイズ).Value
End If
Next
End Sub

お礼

最初うまくいきませんでしたが、.xlsの拡張子を取ったらうまくいきました。今回も素早い回答をありがとうございました。