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 

这很简单，几乎做我想要的东西，但错误的工作表。 我没有设法切换哪个工作表来复制数据。 任何帮助将是最有帮助的。

Answer 1

那是你需要的吗？ 认为你是错误的复制方式，你的抵消是不正确的。

 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