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 'tri sur la 3ème colonne
tablo = .Resize(, 3) 'matrice, plus rapide
End With
For i = 2 To UBound(tablo)
d(tablo(i, 3)) = 0
Next i
tablo = .[A18].CurrentRegion.Resize(, 3) 'à adapter éventuellement
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 'RAZ
[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] 'lance la macro
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 'RAZ
With Sheets("Feuil1").[A18].CurrentRegion
.AutoFilter 3, [C1] 'Filtre automatique
.Copy [A3]
.Parent.AutoFilterMode = False 'ôte le filtre
End With
Rows(3).Font.Bold = True
End Sub