比较两个Excel工作簿并将匹配的数据复制到第三个工作簿

我试图比较excel中的两个工作簿，并让匹配的列数据将整行复制到新的第三个工作簿中。例：

比较

工作簿_1列A到工作簿_2列A，如果名称匹配，请将匹配工作簿_1列A数据的整行复制到第三个工作簿_3

这是我的代码：

Sub RunMe()
Dim lRow, a As Long

Sheets("Workbook_1").Select
lRow = Range("A1").End(alDown).Row

For Each cell In Range("A2:A" & lRow)
    a = 2
    Do
        If cell.Value = Workbook("Workbook_2").Cells(a, "A").Value Then
            cell.EntireRow.Copy Workbook("Workbook_3").Range("A" & Rows.Count).End(alUp).Offset(1, 0)
        End If
        a = a + 1
    Loop Until IsEmpty(Workbook("Workbook_2").Cells(a, "A"))
Next

End Sub

我在另一个网站上找到了这段代码，我编辑了工作簿名称并为其创建了模块，运行了它，但它不工作

任何帮助将不胜感激，我不是很擅长excel，所以请您解释，因为您会为初学者

---

谢谢

您当前的代码无法完成任何与您希望的接近的操作。试试下面的代码，看看它是否适合你。我试图添加一些注释来解释代码的作用。请确保更改代码中的工作簿和工作表名称以匹配实际的书本

Sub RunMe()

    Dim wbk1 As Workbook, wbk2 As Workbook, wbk3 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim lRow1 As Long, lCol1 As Long, lRow3 As Long, x As Long
    Dim myValue As String
    Dim Found As Range

    Set wbk1 = Workbooks("Workbook_1.xlsm") 'Be sure to change these to your actual workbook names
    Set ws1 = wbk1.Worksheets("Sheet1") 'Be sure to change these to your actual worksheet names

    Set wbk2 = Workbooks("Workbook_2.xlsm")
    Set ws2 = wbk2.Worksheets("Sheet1")

    Set wbk3 = Workbooks("Workbook_3.xlsm")
    Set ws3 = wbk3.Worksheets("Sheet1")

    'Using a with block means we don't have to define any range coming from book1. ws1.Range("A2") is the same as .Range("A2")
    With ws1
        'Find last row in ws1 Col A
        lRow1 = .Range("A" & .Rows.Count).End(xlUp).Row
        'Find last column in ws1
        lCol1 = .Cells.Find(What:="*", _
            After:=.Cells(1, 1), _
            LookIn:=xlFormulas, _
            LookAt:=xlPart, _
            SearchOrder:=xlByColumns, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False).Column
        'Start loop to search through all values in column A
        For x = 2 To lRow1
            myValue = .Cells(x, 1).Value
            'Look for value in Workbook2 column A
            Set Found = ws2.Cells.Find(What:=myValue, _
                After:=ws2.Cells(1, 1), _
                LookIn:=xlFormulas, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False)
            'If Found is not nothing then do something
            If Not Found Is Nothing Then
                'Find last row in ws3 Col A
                lRow3 = ws3.Range("A" & .Rows.Count).End(xlUp).Row
                'Instead of using .copy saying "This Range = That Range" is much faster
                ws3.Range(ws3.Cells(lRow3 + 1, 1), ws3.Cells(lRow3 + 1, lCol1)).Value = .Range(.Cells(x, 1), .Cells(x, lCol1)).Value
            End If
        Next x
    End With

End Sub

---

您的代码在哪里出错，出现了什么错误？首先，你说你想循环A列，但你一直在引用E列。嗨，没有错误，当我运行代码时，它需要几分钟运行，然后停止，没有发生任何事情，没有复制或任何事情到工作簿_3-关于A列和E列，它作为A列正确输入，但我在这里输入了我发现的原始代码，编辑了一些代码，以便很容易看出是我的错误还是代码本身。你指的是代码中的工作表，而你却在谈论工作簿？工作簿是一个Excel文件，它可以包含许多工作表，并在文件底部显示选项卡。你指的是哪一个？我指的是工作簿文件，而不是工作表。我建议编辑你的帖子，以准确显示你正在尝试运行的内容，因为这样会更容易帮助你。您是在尝试搜索整个列以查找匹配项，还是仅当book1上的x行与Book2上的x行相等时才进行搜索？感谢代码，我可以与您核对名称更改，是否正确：Set wbk3=workbooks reportable.xlsm Set ws3=wbk3。WorksheetsReportTableSheet@user3103193是的，看起来不错。只需确保您的工作簿保存为.xlsm宏启用项，它们保存为.xlsm-但我在运行它时出现以下错误：运行时错误“9”：下标超出范围。您知道怎么回事吗。@user3103193运行时是否打开了所有工作簿？那么，当抛出错误时，哪一行会突出显示？是的，它们都是打开的，下面是导致错误的那一行：Set wbk1=WorkbooksExped.xlsm’请确保将它们更改为您的实际工作簿名称。