检查值是否存在，如果存在，则将整行复制到另一个工作表-VBA

Question

更新： 我有 2 个工作表：base 和 référence。 référence 是恒定的，有 520 行。我应该将它与可以有 2000 行的基础进行比较。我应该匹配从我引用到基础的每一行。能够拥有例如对于第 1 行，从基础开始，在其旁边（第 1 行的最后一个单元格旁边）添加来自 référence 的匹配行，如果没有匹配，我将有一个空白。

所以，我正在尝试编写一个代码，如果该值存在于另一个工作表的另一列中，则该列的每个值都应该找到：引用。如果是，则复制整行引用并将其粘贴到第一个工作表中匹配的单元格旁边：base。

我有 1600 行以匹配参考表 520 行，我有两个表的公共列，我可以将其用作键。

我尝试了不同的方法，但都没有奏效：问题是它不会粘贴到单元格旁边，而是删除所有行并用引用替换它们！所以我不知道完全匹配的那个。或者我有一条错误消息：选择要粘贴的单元格！

这是我的代码：

Sub CopyPaste2()

Dim y, lastrow, c, firstAddress, i

Set y = Workbooks.Open("Z:\Base_de_données\Base_Para.xlsx")
lastrow = y.Sheets("Réf").Range("G" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
    With y.Worksheets("base").Cells(i, 7)
        Set c = .Find(y.Worksheets("Réf").Range("B" & i).Value, LookIn:=xlValues) 'this identifies the values in worksheet called R?f
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                'c.Entirerow.Copy
                c.y.Sheets("Réf").Range("A" & i & ":D" & i).Copy
                y.Worksheets("base").Range("A" & i).End(xlUp).Offset(1).PasteSpecial _
                    Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
Next i

End Sub

非常感谢您的帮助！

我添加了一个我应该得到什么结果的样本

Sample

Answer 1

创建一个值数组以定位并使用 .AutoFilter 一次性收集所有值。

Option Explicit

Sub CopyPaste2()
    Dim vals As Variant, y As Workbook

    Set y = Workbooks.Open("Z:\Base_de_données\Base_Para.xlsx")

    With y.Worksheets("Réf")
        vals = Application.Transpose(.Range(.Cells(2, "B"), .Cells(.Rows.Count, "B").End(xlUp)).Value)
    End With

    With y.Worksheets("base")
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Columns("G").Cells
            .AutoFilter field:=1, Criteria1:=vals, Operator:=xlFilterValues
            'check if there is anything to copy
            With .Resize(.Rows.Count - 1, 4).Offset(1, -6)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    .Copy Destination:=.Parent.Worksheets("base").Range("A" & .rows.count).End(xlUp).Offset(1, 0)
                End If
            End With
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
    End With

End Sub