Sub Mise_A_Jour()
Dim Rg As Range, C As Range, Plg As Range, Usager As String, Datedébut As String, Datefin As String
Dim Trouve As Range, Adr As String, Ville As String, Ligne As Variant, ColonneDébut As Variant, ColonneFin As Variant
Sheets("Feuil1").Range("D:D").Select
If TypeName(Selection) = "Range" Then
Set Rg = Intersect(Selection, Range("D:D"))
If Not Rg Is Nothing Then
On Error Resume Next
For Each C In Rg
If UCase(C.Value) = UCase("A l'étranger") Then
Ville = C.NoteText
Usager = C.Offset(, -3).Value
Datedébut = C.Offset(, -2).Value
Datefin = C.Offset(, -1).Value
ColonneDébut = Column(, Datedébut, Range("2:2"))
ColonneFin = Range(, Datefin, Range("2:2"))
Ligne = Application.Match(Usager, Range("F:F"), 0)
If Not IsError(Ligne) Then
Set Plg = Range("ColonneDébut" & Ligne & ":" & "ColonneFin" & Ligne)
With Plg
Set Trouve = .Find(What:=Trim(C.Value), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, _
searchdirection:=xlNext, MatchCase:=False)
If Not Trouve Is Nothing Then
Adr = Trouve.Address
Do
Trouve.Comment.Delete
Trouve.AddComment Ville
Trouve.Comment.Shape.OLEFormat.Object.AutoSize = True
Set Trouve = .FindNext(Trouve)
Loop Until Trouve.Address = Adr
End If
End With
Else
Err = 0
End If
End If
Next
End If
End If
End Sub