根据另一个工作簿中的所需条件，将信息复制并粘贴到另一个工作簿中

嗨，我有2个工作簿之一被称为“活跃主项目”，内容超过1国家新项目及其信息。 而另一本名为“简易项目跟踪器”的工作手册，则是一张空白表格，只能复制和粘贴新加坡国家的新项目信息。 我设法出来了一个代码，但它只从“新加坡”国家复制一行信息到简单的项目跟踪工作簿。 但是，在“主动项目”中，“国家”栏目中包含多个“新加坡”国家。 此外，下面的代码不断replace列标题的行时，我试图运行它，而不是将项目信息粘贴到易于项目跟踪工作簿的空行。 这是我到目前为止的代码：

Sub Sample() Dim wb1 As Workbook, wb2 As Workbook Dim ws1 As Worksheet, ws2 As Worksheet Dim copyFrom As Range Dim lRow As Long '<~~ Not Integer. Might give you error in higher versions of excel Dim strSearch As String Set wb1 = Application.Workbooks.Open("U:\Active Master Project .xlsm") Set ws1 = wb1.Worksheets("New Upcoming Projects") strSearch = "Singapore" With ws1 '~~> Remove any filters .AutoFilterMode = False '~~> I am assuming that the names are in Col A '~~> if not then change A below to whatever column letter lRow = .Range("A" & .Rows.Count).End(xlUp).row With .Range("A4:A" & lRow) .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*" Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow End With .AutoFilterMode = False End With '~~> Destination File Set wb2 = ThisWorkbook Set ws2 = wb2.Worksheets("New Upcoming Projects") With ws2 If Application.WorksheetFunction.CountA(.Cells) <> 0 Then lRow = .Cells.Find(What:="*", _ After:=.Range("A4"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).row Else lRow = 1 End If copyFrom.Copy .Rows(lRow) End With End Sub 

我需要一个代码，使我能够遍历活动的主项目工作簿的所有行，并复制所有信息，并将其粘贴到简单的项目跟踪工作簿中，该工作簿由国家/地区列中的“新加坡”组成。在活动主工作簿中找不到更多行时，代码将停止运行。 我希望任何人都可以帮助我。 谢谢。