Vba 使用特定条件将数据从一个工作簿传输到另一个工作簿

我有两本工作簿，一本叫做目标工作簿，另一本叫做源工作簿

目标工作簿具有所有项目ID，并且某些项目ID会多次出现。在源工作簿中，它是空的，因为尚未输入任何数据

我需要一个代码，允许我遍历目标工作簿中项目ID的所有行，我希望将信息传输到源工作簿

例如，我希望项目ID 10000327在目标工作簿中出现多次，并且我需要传输项目ID上有10000327的所有行

目前，我只能找到一次匹配的项目ID，并且不允许我查看所有行，直到找到空行，代码将停止搜索。因此，它不允许我在目标工作簿中捕获多个包含10000327的项目id。这只能在两个工作簿都有项目ID时运行，但我希望代码只关注目标工作簿项目ID并将其传输到源工作簿，而不是在目标工作簿和源工作簿之间进行匹配

这是我目前掌握的代码：

Sub AAB()
    Dim sWS As Worksheet, tWS As Worksheet
    Dim pidCol As Long, pidRow As Long, pidStr As String, rw As Long

    Set tWS = Workbooks("Target.xlsm").Sheets("Sheet1")
    Set sWS = Workbooks("Source.xlsm").Sheets("Sheet2")

    With tWS
        With .Cells(2, 1).CurrentRegion
            pidCol = 1
            pidStr = "10000327"  '.Cells(rw, pidCol).Value
            If CBool(Application.CountIf(.Columns(1), pidStr)) Then
                rw = Application.Match(pidStr, .Columns(1), 0)
                With .Cells(rw, 2).Resize(1, .Columns.Count - 1)
                    If CBool(Application.CountIf(sWS.Columns(1), pidStr)) Then
                        pidRow = Application.Match(pidStr, sWS.Columns(1), 0)
                        .Copy Destination:=tWS.Cells(pidRow, 2)
                    End If
                End With
            End If
        End With
    End With

    Set sWS = Nothing
    Set tWS = Nothing
End Sub

我希望任何人都能帮助我，因为我已经被困在这几乎两个星期了。

---

谢谢。

你的方式不是有点太复杂了吗。也许我误解了什么，但是如果您想找到一个项目id并将该行复制到不同的工作簿中，您可以循环浏览这些行并复制具有正确项目id的行：

For LineNo = 2 To Range("A1").End(xlDown).Row
    If Range("A" & LineNo).Value = pidStr Then
        sWS.Rows(LineNo & ":" & LineNo).Copy Destination:=tWS.Rows(tWS.Range("A1").End(xlDown).Row + 1 & ":" & tWS.Range("A1").End(xlDown).Row + 1)
    End If
Next LineNo

或者，您可以过滤数据表并仅复制其余行：

ActiveSheet.Range("$A$1:$C$" & Range("A1").End(xlDown).Row).AutoFilter Field:=1, Criteria1:=pidStr
Rows("2:" & Range("A1").End(xlDown).Row).SpecialCells(xlCellTypeVisible).Copy Destination:=tWS.Rows(tWS.Range("A1").End(xlDown).Row + 1 & ":" & tWS.Range("A1").End(xlDown).Row + 1)