Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim source As Range, dest As Range
Set source = [A1:A100]
Set dest = [D15:D114]
If Not Intersect(ActiveCell, source) Is Nothing And _
Evaluate("SUM((" & source.Address & "<>"""")*(" & source.Address & "=" & dest.Address & "))") < 4 _
Then dest(ActiveCell.Row - source.Row + 1, 1) = ActiveCell
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim source As Range, dest As Range, r As Range
Set source = [A1:A100]
Set dest = [D15:D114]
Set r = Intersect(Target, source)
If r Is Nothing Then Exit Sub
Cancel = True
For Each r In r 'si sélection multiple
dest(r.Row - source.Row + 1) = ""
Next
End Sub