Excel VBA比较两个工作簿中的值，然后复制数据

我正在寻找一个VBA脚本，用于比较workbook1上的D列和workbook2上的a列。 如果匹配，我希望将workbook2列G中的数据复制到woksbook1列E中

我找到了这个脚本：

Sub UpdateW2()

Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, FR As Long

Application.ScreenUpdating = False

Set w1 = Workbooks("Excel VBA Test.xlsm").Worksheets("Blad1")
Set w2 = Workbooks("Excel VBA Test Backbone.xlsx").Worksheets("Blad1")

For Each c In w1.Range("D2", w1.Range("D" & Rows.Count).End(xlUp))
    FR = 0
    On Error Resume Next
    FR = Application.Match(c, w2.Columns("A"), 0)
    On Error GoTo 0
    If FR <> 0 Then w1.Range("C" & FR).Value = c.Offset(, -3)
Next c
Application.ScreenUpdating = True
End Sub

子更新w2（）
尺寸w1作为工作表，w2作为工作表
尺寸c作为范围，FR作为长度
Application.ScreenUpdating=False
设置w1=工作簿（“Excel VBA Test.xlsm”）。工作表（“Blad1”）
Set w2=工作簿（“Excel VBA测试主干.xlsx”）。工作表（“Blad1”）
对于w1.范围内的每个c（“D2”，w1.范围（“D”和行数）。结束（xlUp））
FR=0
出错时继续下一步
FR=Application.Match（c，w2.列（“A”），0）
错误转到0
如果FR为0，则w1.范围（“C”&FR）.值=C.偏移量（，-3）
下一个c
Application.ScreenUpdating=True
端接头

它很简单，几乎做了我想做的事情，但进入了错误的工作表。 我也无法切换要复制数据的工作表。

---

任何帮助都会非常有用。

这就是你需要的吗？我想你复制的方向不对，偏移量也不对

Sub UpdateW2()

Dim w1 As Worksheet, w2 As Worksheet
Dim c As Range, FR As Variant

Application.ScreenUpdating = False

Set w1 = Workbooks("Excel VBA Test.xlsm").Worksheets("Blad1")
Set w2 = Workbooks("Excel VBA Test Backbone.xlsx").Worksheets("Blad1")

For Each c In w1.Range("D2", w1.Range("D" & Rows.Count).End(xlUp))
    FR = Application.Match(c, w2.Columns("A"), 0)
    If IsNumeric(FR) Then c.Offset(, 1).Value = w2.Range("G" & FR).Value
Next c

Application.ScreenUpdating = True

End Sub

---

我有w1中的代码和一个在工作簿中执行的按钮。比我快8秒：）@ShaiRado-我可能在你之前见过它，有两条裂缝。