Private Sub Worksheet_Activate()
Dim d As Object, tablo, i&, v, a, b
Set d = CreateObject("Scripting.Dictionary")
With Sheets("Feuil1")
With .[A1].CurrentRegion.EntireRow
.Sort .Columns(3), xlAscending, Header:=xlYes
tablo = .Resize(, 3)
End With
For i = 2 To UBound(tablo)
d(tablo(i, 3)) = 0
Next i
tablo = .[A18].CurrentRegion.Resize(, 3)
For i = 2 To UBound(tablo)
v = tablo(i, 3)
If d.exists(v) Then d(v) = v
Next i
a = d.keys: b = d.items
For i = 0 To UBound(a)
If b(i) = 0 Then d.Remove a(i)
Next i
[C1].Validation.Delete
[E1].Resize(, Columns.Count - 4).ClearContents
If d.Count Then [E1].Resize(, d.Count) = d.items: [C1].Validation.Add xlValidateList, Formula1:="=" & [E1].Resize(, d.Count).Address
Worksheet_Change [C1]
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$C$1" Then Exit Sub
Application.ScreenUpdating = False
[A3].CurrentRegion.Clear
With Sheets("Feuil1").[A18].CurrentRegion
.AutoFilter 3, [C1]
.Copy [A3]
.Parent.AutoFilterMode = False
End With
Rows(3).Font.Bold = True
End Sub