Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D4]) Is Nothing Then Exit Sub
Dim lig
lig = Application.Match([D4], Sheets("Feuil1").Columns("A"), 0)
If IsError(lig) Then MsgBox "Valeur introuvable...": Exit Sub
Application.EnableEvents = False
[F4].ClearContents
Application.EnableEvents = True
If Sheets("Feuil1").Cells(lig, "B").Hyperlinks.Count = 0 Then Exit Sub
Application.EnableEvents = False
Sheets("Feuil1").Cells(lig, "B").Copy [F4] 'copier-coller
[F4].Hyperlinks(1).TextToDisplay = "lien"
Application.EnableEvents = True
End Sub