After the last match is found, how do I make the loop stop

The code I have is matching certain criteria's and based on that copying them from an import page to an output page. It is working in the sense that it is finding all the right matches. However, the last match it finds it is returning that 3 times instead of just 1 time. How do I make the loop stop immediately after the last match is found?

I do have to note that my knowledge regarding VBA is pretty limited. This code was produced with the help of forum members here.

If required I could submit the excel file as well, if that makes things easier.

Option Explicit

Dim wsImport As Worksheet

Sub Sample()
    Dim wsSpec As Worksheet
    
    Set wsImport = ThisWorkbook.Sheets("Import")
    Set wsSpec = ThisWorkbook.Sheets("Specifications")
    
    Dim CriteriaA As String, CriteriaB As String, CriteriaC As String
    Dim aCell As Range, bCell As Range
    Dim origin As String, KeyToFind As String
    Dim rngDB As Range
    Dim strAdress As String
    
    With wsSpec
        CriteriaA = wsImport.Range("C3").Value2
        CriteriaB = wsImport.Range("C4").Value2
        CriteriaC = wsImport.Range("C5").Value2
        
        Set rngDB = .Range("h1", .Range("h" & Rows.Count).End(xlUp))
       
        Set aCell = rngDB.Find(What:=CriteriaA, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
        If Not aCell Is Nothing Then
            strAdress = aCell.Address
            Do
                If aCell.Offset(, 1).Value2 = CriteriaB And _
                   aCell.Offset(, 2).Value2 = CriteriaC Then
                   origin = aCell.Offset(, 6).Value2
                   KeyToFind = aCell.Offset(, 7).Value2
                End If
                If origin = "Letters" Then
                    CopyRows "M", KeyToFind, True
                ElseIf origin = "Numbers" Then
                    CopyRows "H", KeyToFind, False
                End If
                 Set aCell = rngDB.FindNext(aCell)
            Loop While aCell.Address <> strAdress
        End If
    End With
End Sub
Private Sub CopyRows(Col As String, SearchString As String, PartialString As Boolean)
    Dim copyFrom As Range
    Dim lRow As Long
    Dim LastRow As Long
     
    With wsImport
        .AutoFilterMode = False
        
        lRow = .Range(Col & .Rows.Count).End(xlUp).Row

        With .Range(Col & "1:" & Col & lRow)
            If PartialString = False Then
                .AutoFilter Field:=1, Criteria1:=SearchString
            Else
                .AutoFilter Field:=1, Criteria1:="=*" & SearchString & "*"
            End If
            
            Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells
        End With
        .AutoFilterMode = False
    End With
   
    Dim wsOutput As Worksheet
    Set wsOutput = ThisWorkbook.Sheets("Output")
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    If Not copyFrom Is Nothing Then
        If wsOutput.Range("A1") = "" Then
                copyFrom.Copy wsOutput.Range("A1")
        Else
                copyFrom.Copy wsOutput.Range("a" & LastRow)(2)
        End If
    End If
End Sub

Edit: Per request screenshots:

Import: Specifications: