VBA基于2个条件将行从一张图纸复制到另一张图纸

我有两张羊皮。基本上，ws1是目标，ws2是源。然后我有两个标准，一个身份证号码，和一个将处理身份证号码的人的名字

源包含一行，其中包含“工作人员”完成的新操作/进度，需要将其粘贴到目标上才能更新

我读过很多书，看到自动过滤器看起来是一个不错的选择。我这里有一个自动过滤的代码，但我不确定如何“攻击”这个问题

Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrowDest As Long, currow As Long, lastrowSrc As Long
Dim critvalue1 As String


'Destination sheet (dashboard)
Set ws1 = Sheets("Destination")
'Source Sheet (source)
Set ws2 = Sheets("Source")

lastrowSrc = ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
lastrowDest = ws1.Range("A" & Rows.Count).End(xlUp).Row



For currow = 2 To lastrowSrc

critvalue1 = ws2.Range("E" & currow).Value

ws1.Range("A1").AutoFilter field:=5, Criteria1:=critvalue1



Next currow

end sub

如果IDnumber匹配，是否有一种简单的方法将行从源复制到目标？（IDnumber是唯一的）

上面的代码进行了筛选，但我不确定如何复制或移动行

---

提前感谢。

我从我使用的一个更大的宏中提取了这个，并做了一些更改，使其更好地匹配您的方法，并且删除了一些不相关的内容。变量名有点不同。我相信这正是你所需要的。如果给你带来麻烦，请告诉我。 在运行之前，不要忘记填充ID和名称数组，设置2个列变量的值，并分配工作表名称

Sub copyByAutofilter()

Dim filterList1 As Variant
    filterList1 = Array("ID1", "ID2")
    filterCol1 = 1 'or whatever column contains the IDs
Dim filterList2 As Variant
    filterList2 = Array("Name1", "Name2")
    filterCol2 = 2 'or whatever column contains the names

Dim sourceWB As String
    sourceWB = ThisWorkbook.Name
Dim sourceWS As String
    sourceWS = "Sheet2"
Dim destinationWB As String
    destinationWB = ThisWorkbook.Name
Dim destinationWS As String
    destinationWS = "Sheet3"

lastrowSrc = Sheets(sourceWS).Range("A" & Rows.Count).End(xlUp).Offset(1).Row
lastrowDest = Sheets(destinationWS).Range("A" & Rows.Count).End(xlUp).Row

Workbooks(sourceWB).Sheets(sourceWS).AutoFilterMode = False

Workbooks(sourceWB).Sheets(sourceWS).Range("$A$1:$O" & lastrowSrc).AutoFilter Field:=filterCol1, _
        Criteria1:=filterList1, Operator:=xlFilterValues
Workbooks(sourceWB).Sheets(sourceWS).Range("$A$1:$O" & lastrowSrc).AutoFilter Field:=filterCol2, _
        Criteria1:=filterList2, Operator:=xlFilterValues

Workbooks(sourceWB).Sheets(sourceWS).Range("A2:O" & lastrowSrc).SpecialCells _
        (xlCellTypeVisible).Copy _
        Destination:=Workbooks(destinationWB).Sheets(destinationWS).Cells(lastrowDest + 1, 1)

End Sub

---

这可以通过SUMPRODUCT或VLOOKUP完成，但如果您设置为VBA，请尝试此方法

Sub copyRow()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrowDest As Long, currowSrc As Long, currowDest As Long, lastrowSrc As Long
Dim critvalue1 As String

Set ws1 = Sheets("Sheet2")
Set ws2 = Sheets("Sheet1")

lastrowSrc = ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).Row - 1
lastrowDest = ws1.Range("A" & Rows.Count).End(xlUp).Row

For currowSrc = 2 To lastrowSrc
    critvalue1 = ws2.Range("E" & currowSrc).Value
    ws2.Cells(6, 5).Value = critvalue1
    For currowDest = 2 To lastrowDest
        If ws1.Range("E" & currowDest).Value = critvalue1 Then
           ws2.Rows(currowSrc).Copy Destination:=ws1.Range("A" & currowDest)
        End If
    Next currowDest
Next currowSrc

End Sub

我发现这比处理自动过滤器更容易。它从源工作表逐行执行，并检查目标工作表的每一行是否匹配。如果存在匹配项，则中的源行将复制到匹配的目标行

保留格式而不是

ws2.Rows(currowSrc).Copy Destination:=ws1.Range("A" & currowDest)

使用

---

一种方法是使用

Range

对象的

Copy

方法。通常应避免这种情况，因为这会覆盖剪贴板。更安全的选择是简单地使用

rngDest.Value=rngSrc.Value

。请注意，要使其工作，范围必须相同大小。以下是通常使用的方法：

Dim dst As Range
Dim src As Range
Set src = Range("A1:B3") 'Data you want to copy 
Set dst = Range("C1") 'First cell in the destination Range
Set dst = dst.Resize(src.Rows.Count, src.Columns.Count) 'Resize to match src
dst.Value = src.Value 'Copy to destination

---

此方法的优点是保留剪贴板

为什么不直接使用

VLOOKUP

函数呢？如果我正确理解了您的问题，就不需要宏。您的代码只显示一个条件，而另一个条件在哪里？您肯定不想将自动筛选代码放入循环中。你只需过滤一次。嗨，这看起来很快就有了结果。我有一个关于“ws2.Cells（6,5）.Value=critvalue1”的问题，关于它的作用。很抱歉，我没有把它取出来。这只是为了让我能够看到故障排除的

criticalvalue1

的值。我没有包括的另一件事是

Application.screenUpdate=False

和

Application.screenUpdate=True

。这将关闭屏幕更新，以便在代码运行时屏幕不会闪烁，如果处理大量数据，则可以大大提高速度。false关闭更新，因此放在

设置ws2

之后。如果为true，则会将其重新打开，因此请将其放在

End Sub

之前。源行包含公式，我需要在复制时将其转移到。有什么建议吗？如果不知道公式，我无法提供确切的帮助。我试过了，它复制了方程。您只需确保锁定电池，否则它将尝试调整。例如，

=SUM（A2:A10）

在复制时会更改，但

=SUM（$A$2:$A$10）

在复制时不会更改。您好，不是复制公式和整行，而是复制特定列吗？例如第34列、第35列等）

Dim dst As Range
Dim src As Range
Set src = Range("A1:B3") 'Data you want to copy 
Set dst = Range("C1") 'First cell in the destination Range
Set dst = dst.Resize(src.Rows.Count, src.Columns.Count) 'Resize to match src
dst.Value = src.Value 'Copy to destination