Sub test()
Dim liens()
ReDim liens(1 To 4, 1 To 1)
For Each sh In Sheets
If sh.Name <> ActiveSheet.Name Then
For m = 1 To sh.Hyperlinks.Count
liens(1, UBound(liens, 2)) = sh.Hyperlinks(m).Name
liens(2, UBound(liens, 2)) = sh.Hyperlinks(m).Address
liens(3, UBound(liens, 2)) = sh.Hyperlinks(m).SubAddress
liens(4, UBound(liens, 2)) = sh.Hyperlinks(m).TextToDisplay
ReDim Preserve liens(1 To 4, 1 To UBound(liens, 2) + 1)
Next m
End If
Next sh
For n = LBound(liens, 2) To UBound(liens, 2) - 1
Nom = liens(1, n)
MsgBox (liens(1, n) & " " & liens(2, n))
Set c = ActiveSheet.Cells.Find(Nom, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If liens(2, n) <> "" Then
ActiveSheet.Hyperlinks.Add Anchor:=c, Address:=liens(2, n), TextToDisplay:=liens(4, n)
Else
ActiveSheet.Hyperlinks.Add Anchor:=c, Address:=liens(2, n), SubAddress:=liens(3, n), TextToDisplay:=liens(4, n)
End If
Set c = ActiveSheet.Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Next n
End Sub