Question

我有2张纸。基本上ws1是目的地，ws2是源。那么我有2个标准，一个身份证号码，以及将要处理身份证号码的人的姓名。

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

我已经读过并看到自动过滤器看起来像是要走的路。我在这里有一个自动过滤器的代码，但我不知道我怎么能“攻击”这个问题。

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是唯一的）

上面的代码过滤但我不确定如何复制或移动行。

提前感谢。

Answer 1

这可以通过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)

使用

ws2.Rows(currowSrc).Copy
ws1.Range("A" & currowDest).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats

Answer 2

我将其从我使用的较大宏中取出并进行了一些更改，使其与您的方法匹配得更好一些，并删除了一些不相关的内容。变量名有点不同。我相信这可以满足您的需求。如果它给你带来麻烦，请告诉我。不要忘记填充ID和Name数组，设置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

Answer 3

一种方法是使用Copy对象的Range方法。这通常应该避免，因为这会覆盖剪贴板。更安全的选择是简单地使用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

此方法具有保留剪贴板的好处！

VBA根据2个条件将行从一个工作表复制到另一个工作表

3 个答案: