Public Sub FindAndRepace()
    ' На Листе2 находится справочник.
    '      A         B
    ' 1 123456789   1234
    ' 2 987654321   9876
    ' 3 999999999   9999
    ' ...
    ' 20 ...
    ' На Листе1 наши 20000 строк с номерами.
    
    Dim firstAdress As String
    Dim rng As Range
    Dim intI As Integer
    Dim Start, Finish, TotalTime
    
    Start = Timer
    
    For intI =  1  To  20 
        Set rng = Worksheets("Лист1").Range("A1:A20000"). _
          Find(What:=CStr(Worksheets("Лист2").Range("A" & intI)), LookIn:=xlValues, _
          LookAt:=xlWhole, MatchCase:=False)
        If Not (rng Is Nothing) Then
            Do
                rng.Value = Worksheets("Лист2").Range("A" & intI).Offset( 0 ,  1 ).Value
                Set rng = Range("A1:A20000").FindNext(rng)
            Loop While Not (rng Is Nothing)
        End If
    Next intI
    
    Finish = Timer
    TotalTime = Finish - Start
    
    MsgBox "Всего времени: " & TotalTime
    ' У меня получается 27 сек. PIII-800.
End Sub