Copy the line where VLOOKUP Loop results in NA (index problem)

My code looks up values in one worksheet A in another worksheet B, and inputs data from a column in B if the values in A and B match.

However, I am trying to copy those lines, where Vlookup returns #NA to the end of A data. The way I do it though, the for loop remains at the first index and copies an n-amount of lines with the first index content.

    Dim LastCol As Long
    Dim rng As Range
    Set rng = TargetWorksheet.Cells ' Use all cells on the sheet
    LastCol = Last(2, rng) ' Find the last col
    lastRowM = TargetWorksheet.Cells(TargetWorksheet.Rows.Count, "A").End(xlUp).Row

    Dim rngToA         As Range
    Dim rngfromB       As Range
    Dim rngCelToA      As Range
    Dim rngCelfromB    As Range

    Set rngToA = TargetWorksheet.Range("$D$1:$D$700")
    Set rngfromB = ActiveSheet.Range("D13:D700")

    For Each rngCelToA In rngToA.Cells
        If Trim(rngCelToA) <> "" Then
            For Each rngCelfromB In rngfromB.Cells
                If UCase(Trim(rngCelToA)) = UCase(Trim(rngCelfromB)) Then
                    rngCelToA.Cells(, LastCol - 2) = Application.VLookup(rngCelToA, ActiveSheet.Range("D13:P700"), 13, False)
                    ElseIf IsError(Application.VLookup(rngCelToA, ActiveSheet.Range("D13:P700"), 13, False)) Then
                        'index rngCelfromB
                         ActiveSheet.Rows(rngCelfromB.Row).Copy Destination:=TargetWorksheet.Cells(lastRowM + 1, 1)
                         lastRowM = lastRowM + 1
                    Exit For
                End If
            Next rngCelfromB
        End If
    Next rngCelToA

    Set toCelToA = Nothing
    Set fromB = Nothing
    Set rngCelToA = Nothing
    Set rngfromB = Nothing
    Set rngCelCelToA = Nothing
    Set rngCelfromB = Nothing

Here is the code for the Last()-funtion:

    Function Last(choice As Long, rng As Range)
   'Ron de Bruin, 5 May 2008
   ' 1 = last row
   ' 2 = last column
   ' 3 = last cell
    Dim lrw As Long
    Dim lcol As Long

    Select Case choice

    Case 1:
        On Error Resume Next
        Last = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        On Error GoTo 0

    Case 2:
        On Error Resume Next
        Last = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

    Case 3:
        On Error Resume Next
        lrw = rng.Find(What:="*", _
                       After:=rng.Cells(1), _
                       Lookat:=xlPart, _
                       LookIn:=xlFormulas, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious, _
                       MatchCase:=False).Row
        On Error GoTo 0

        On Error Resume Next
        lcol = rng.Find(What:="*", _
                        After:=rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0

        On Error Resume Next
        Last = rng.Parent.Cells(lrw, lcol).Address(False, False)
        If Err.Number > 0 Then
            Last = rng.Cells(1).Address(False, False)
            Err.Clear
        End If
        On Error GoTo 0

    End Select
   End Function