Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
Dim F1 As Worksheet, F2 As Worksheet, cel As Range, cible As Range, firstAddress As String, TexteCellule As String
Set F1 = Feuil1 'CodeName, à adapter
Set F2 = Feuil2 'CodeName, à adapter
F1.Hyperlinks.Delete 'supprime tous les liens hypertexte
F1.[A:A].Font.ColorIndex = xlAutomatic 'format police
F1.[A:A].Font.Underline = xlUnderlineStyleNone
For Each cel In F1.Range("A2", F1.[A65536].End(xlUp)) 'plage/colonne à adapter
If cel.Text <> "" Then
Set cible = F2.Cells.Find(cel.Text, , xlValues, xlWhole)
TexteCellule = cel.Text
If Not cible Is Nothing Then
firstAddress = cible.Address
Do
F1.Hyperlinks.Add cel, "", F2.CodeName & "!" & cible.Address, TextToDisplay:=TexteCellule
cel.Font.Name = "Arial"
cel.Font.Size = 10
Set cel = cel.Offset(0, 1)
Set cible = F2.Cells.FindNext(cible)
Loop While Not cible Is Nothing And cible.Address <> firstAddress
End If
End If
Next cel
End Sub