Private Sub Worksheet_Change(ByVal Target As Range)
Dim StrValidation As String
Dim r As Range
Dim cel As Range
If Target.Column = 5 And Target.Count = 1 Then
Set r = Sheets("Liste commentaire").Columns(1).Find(Target.Value, , xlValues, xlWhole)
If Not r Is Nothing Then
For Each cel In r.MergeArea
StrValidation = IIf(StrValidation = "", cel.Offset(0, 1).Value, StrValidation & "," & cel.Offset(0, 1).Value)
Next cel
End If
'Ajoute la validation sur la cellule a droite de la cellule cible
Target.Offset(0, 1).Validation.Delete
Target.Offset(0, 1).Value = ClearContents
If StrValidation <> "" Then
With Target.Offset(0, 1).Validation
.Delete
If StrValidation <> "" Then
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=StrValidation
End If
End With
End If
End If
End Sub