Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 Or Target.Count > 1 Or Target = "" Then Exit Sub
For i = 4 To 16 Step 4
If Target.Column <> i Then
Set Trouve = Columns(i).Find(Target)
If Not Trouve Is Nothing Then
Target.Interior.ColorIndex = 43
Trouve.Interior.ColorIndex = 43
End If
End If
If Target.Column = i Then
For j = 2 To Cells(2, i).End(xlDown).Row
If Cells(j, i) = Target And Cells(j, i).Address <> Target.Address Then
Target.Interior.ColorIndex = 3
Cells(j, i).Interior.ColorIndex = 3
End If
Next
End If
Next
Set Trouve = Nothing
End Sub