将信息从一个工作簿复制到具有特定条件的另一个工作簿

嗨，我需要一个代码，允许我复制粘贴信息从一个名为“目标”的工作簿到另一个名为“源”的工作手册根据特定的条件。

此条件基于代码中的唯一项目ID。

我试着做一些编码，但似乎并没有让我得到我想要的结果。

该代码将只读取第一行并将信息复制到另一个工作簿，而不是查看目标工作簿“项目ID”列中的项目ID“10000327”，并将信息复制到源工作簿。

下面是我尝试过的代码，并给出了我之前提到的结果。

真的希望任何人都可以帮助我，因为我对VBA很新颖。 谢谢：）

Sub AAA() Dim source As Worksheet Dim target As Worksheet Dim cellFound As Range Set target = Workbooks("Target.xlsm").Sheets("Sheet1") Set source = Workbooks("Source.xlsm").Sheets("Sheet2") lastrow = source.Range("A" & target.Rows.Count).End(xlUp).Row lastcol = target.Cells(2, target.Columns.Count).Column target.Activate 'For a = 2 To 50 For Each cell In target.Range("A2:A500") ' Try to find this value in the source sheet Set cellFound = source.Range("A:A").Find(What:="10000327", LookIn:=xlValues, LookAt:=xlWhole) If Not cellFound Is Nothing Then cell.Offset(ColumnOffset:=1).Copy cellFound.Offset(ColumnOffset:=1).PasteSpecial xlPasteValues Else Exit Sub End If Next 

Answer 1

我已经把硬编码的search术语改成了一个var，它在连续循环中得到了pid。

 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 sWS With .Cells(1, 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(tWS.Columns(1), pidStr)) Then pidRow = Application.Match(pidStr, tWS.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 

如果在目标工作表上find关联的PID，则循环遍历源工作表pidCol = 1 A（ pidCol = 1 ）中的所有值，并将数据复制到目标工作表。

Answer 2

如果我正确地理解了你的问题，我想这里发生的是for循环为每个单元运行一次find命令，但它运行相同的find命令，每次只返回第一个匹配。 如果你使用的是find命令，我认为你可以使用do … while循环，然后使用“findnext”。 MSDN的帮助给出了一个我认为正是你想要做的例子：

 With Worksheets(1).Range("a1:a500") Set c = .Find(2, lookin:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do c.Value = 5 Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End If End With 

另一个select是检查你在for循环中的每个单元格是否匹配。