Private Sub CommandButton1_Click()
Dim kon1 As Long, kon2 As Long, i As Long, j As Long
''Определяем массивчик нужной размерности
Dim m1 As Variant, m2 As Variant
'' определение последней строки на Sheet1
Worksheets("Лист1").Activate
kon1 = ActiveSheet.Range("A3:A30000").Find(What:="").Row
'' определение последней строки на Sheet3
kon2 = Worksheets("Лист3").Range("A3:A300").Find(What:="").Row
''Загружаем таблицу соответствий в массив М2
m2 = Worksheets("Лист3").Range("A3:B" & kon2)
''Загружаем длинные номера в массив М1
m1 = ActiveSheet.Range("A3:A" & kon1)
''Сравниваем
For i = 1 To kon1 - 3
For j = 1 To kon2 - 3
If m2(j, 1) = m1(i, 1) Then m1(i, 1) = m2(j, 2)
Next j
Next i
''вставляем на место длинных короткие
ActiveSheet.Range("A3:A" & kon1) = m1
MsgBox ("ГОТОВО!!!")
End Sub

Эта такая же задача. Только 2 листа, а не две книги. Кстати решить помогли здесь