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

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

此条件基于代码中的唯一项目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 

我已经把硬编码的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 )中的所有值,并将数据复制到目标工作表。

如果我正确地理解了你的问题,我想这里发生的是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循环中的每个单元格是否匹配。