VBA根据2个标准将行从一个表复制到另一个表
我有2片。 基本上ws1是目标，ws2是源。 那么我有2个标准，一个身份证号码和一个工作在身份证号码上的人的名字。
源代码包含一行新的操作/进度由“工作人员”完成，并需要粘贴到目的地，以便更新它。
我读过，看到自动filter看起来像要走的路。 我有一个代码在这里，自动filter，但我只是不知道我怎么能“攻击”的问题。
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 是否有一个简单的方法来复制行从源到目的地提供的ID号匹配？ （ID号码是唯一的）
上面的代码filter，但我不知道如何复制或移动行。
提前致谢。
这可以通过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
我发现它比处理自动filter更容易。 它从源表逐行进行检查，并在目标表的每一行中检查匹配。 如果匹配，则将源行复制到匹配的目标行中。
保持格式而不是
ws2.Rows(currowSrc).Copy Destination:=ws1.Range("A" & currowDest)
使用
ws2.Rows(currowSrc).Copy ws1.Range("A" & currowDest).Select Selection.PasteSpecial Paste:=xlPasteValues Selection.PasteSpecial Paste:=xlPasteFormats
我从我使用的一个更大的macros中拉出了这个，并做了一些修改，使它与你的方法更好地匹配，并删除了一些不相关的东西。 variables名称有点不同。 我相信这是你所需要的。 让我知道，如果它给你麻烦。 不要忘记填充ID和名称数组，设置2列variables的值，并在运行之前分配表名。
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
一种方法是使用Range对象的Copy方法。 这通常应该避免，虽然这会覆盖剪贴板。 一个更安全的select是简单地使用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
这种方法有保留剪贴板的好处！