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

Question

嗨我有2个工作簿，一个叫做“活跃的主项目”，内容超过1个国家的新项目及其信息。虽然另一个工作簿称为“简单项目跟踪器”，但有一个空白工作表将仅基于“新加坡”国家复制和粘贴新项目信息。我设法提出了一个代码，但它只将一行信息从“新加坡”国家复制到简易项目跟踪工作簿。但是，在“活动主项目”中，它包含“国家/地区”列中的多个“新加坡”国家/地区。此外，当我尝试运行它而不是将项目信息粘贴到easy项目跟踪器工作簿的空行时，下面的代码会继续替换列标题的行。 这是我到目前为止的代码：

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

我需要一个代码，允许我遍历活动主项目工作簿的所有行并复制所有信息并将其粘贴到简单的项目跟踪工作簿中，该工作簿由Country列中的“Singapore”组成，这是列A.当活动主工作簿中找不到更多行时，代码将停止运行。我希望有人能帮助我。谢谢。