VBA根据2个条件将行从一张纸复制到另一张纸 [英] VBA copy row from one sheet to another based on 2 criteria

问题描述

我有2张便笺簿.基本上，ws1是目的地，ws2是源.那么我有2个条件，一个ID号和将要使用该ID号的人员的姓名.

源包含一行，其中包含工作人员"执行的新操作/进度，需要将其粘贴到目标上以进行更新.

我已经看过一遍，看到自动过滤器看起来很可行.我在这里有一个可以自动过滤的代码，但是我不确定我如何攻击"问题.

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匹配，就可以将行从源复制到目标? (ID号是唯一的)

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

提前谢谢.

解决方案

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

i have 2 sheeets. basically ws1 is the destination, ws2 is the source. then i have 2 criterias, an ID Number, and a name of the person who will work on the ID Number.

source contains a row with new actions/progress done by "working person" and need to paste it on the destination in order to update it.

I've read around and saw that autofilter looks like the way to go. i have a code here that autofilters, but i'm just not sure how i can "attack" the problem.

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

is there an easy way to copy the row from source to destination provided that the IDnumber matches? (the IDnumber is unique)

the code above filters but i'm not sure of how to copy or move the rows.

thanks in advance.

解决方案

This could be done with SUMPRODUCT or VLOOKUP but if you are set on VBA then try this

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

I find it easier than dealing with the autofilter. It goes row by row from the source sheet and checks for a match in every row of the destination sheet. If there is a match, the source row in copied to the matching destination row.

To keep formatting instead of

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

use

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

这篇关于VBA根据2个条件将行从一张纸复制到另一张纸的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！