Макрос
Sub Метод()
Dim arr(), lr As Long, i As Long
'1. Отключение монитора, чтобы ускорить работу программы.
Application.ScreenUpdating = False
'2. Поиск последней строки в столбце B.
' При использовании метода "End" на листе не должно быть скрытых строк.
lr = Cells(Rows.Count, "B").End(xlUp).Row
'3. Копирование данных из экселя в массив, чтобы ускорить работу программы:
' с массивом быстрее работать, чем с эксель-ячейками.
' В данном случае массив будет использоваться только для того, чтобы извлекать данные
' из столбца C.
If lr = 1 Then
ReDim arr(1 To 1, 1 To 1)
arr(1, 1) = Range("C1").Value
Else
arr() = Range("C1:C" & lr).Value
End If
'4. Движение по строкам с первой до последней.
For i = 1 To UBound(arr, 1)
Cells(i, "C").Hyperlinks.Add Anchor:=Cells(i, "C"), Address:=Cells(i, "B").Hyperlinks(1).Address, _
TextToDisplay:=arr(i, 1)
Next i
'5. Включение монитора.
Application.ScreenUpdating = True
End Sub