HI I would like to make below code changed so when it save in Sheet "Match". it save from last used row. So i can save more than one result, without delete the preveous result.
Please have a look thanks

Sincerely
Abjac

I guess its here it have to be changed

With Sheets("Match").Range("A1").Resize(, 2)
    
        .CurrentRegion.ClearContents
        .Value = [{"Names.","Customer Numbers."}]
         
        .Offset(1).Resize(n).Value = a

The complete code 


Option Explicit

Sub FIndmatches()
    Dim a, e, s, i As Long, n As Long
    a = Sheets("Findsheet").Cells(1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(a, 1)
            Set .Item(a(i, 1)) = _
            CreateObject("Scripting.Dictionary")
            .Item(a(i, 1)).CompareMode = 1
        Next
        a = Sheets("Lookupsheet").Cells(1).CurrentRegion.Value
        For i = 2 To UBound(a, 1)
            If .exists(a(i, 1)) Then .Item(a(i, 1))(a(i, 2)) = Empty
        Next
        ReDim a(1 To UBound(a, 1), 1 To 2)
        For Each e In .Keys
            n = n + 1: a(n, 1) = e: a(n, 2) = "No Match"
            If .Item(e).Count > 0 Then
                For Each s In .Item(e).Keys
                    a(n, 2) = s: n = n + 1
                Next
                n = n - 1
            End If
        Next
        
    End With
    With Sheets("Match").Range("A1").Resize(, 2)
    
        .CurrentRegion.ClearContents
        .Value = [{"Names.","Customer Numbers."}]
         
        .Offset(1).Resize(n).Value = a
       
    End With
    Call QuickCull
End Sub