Sub New_AddressNew()

    Dim out()
    With Worksheets("TP")
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        arrXY = .Range("B1").Resize(LastRow, 2)

    End With
    With Worksheets("New_address_sheet")
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        arrXYZ = .Range("B1").Resize(LastRow, 3)

    End With

    ReDim out(1 To UBound(arrXY), 1 To 1)
    For n = 2 To UBound(arrXY)
        deltax = 10000#
        deltaY = 10000#
        curAdr$ = ""
        For i = 2 To UBound(arrXYZ)
            dx = Abs(arrXY(n, 1) - arrXYZ(i, 1))
            dy = Abs(arrXY(n, 2) - arrXYZ(i, 2))
            If deltax > dx And deltaY > dy Then
                deltax = dx
                deltaY = dy
                curAdr$ = arrXYZ(i, 3)
            End If

        Next
        out(n, 1) = curAdr$
    Next
    Worksheets("TP").Range("f1").Resize(UBound(out), 1) = out
End Sub