Sub Macro()
'permet à la case à cocher d'être cochée immédiatement
Application.OnTime 1, "FiltreCouleur"
End Sub
Sub FiltreCouleur()
Dim t#, ref As Range, ncol%, P As Range, a As Range, coul&, i&, j%
t = Timer
Set ref = [B8:B6208] 'à adapter
ncol = 17 'nombre de colonnes du tableau, à adapter
Set P = ref.Offset(, 1).Resize(, ncol)
Application.ScreenUpdating = False 'pour accélérer
ref = "" 'RAZ
For Each a In [B2:B6] 'cellules liées aux cases à cocher
If a Then
coul = a(, 0).Interior.Color 'en colonne A
For i = 1 To P.Rows.Count
If ref(i) = "" Then
For j = 1 To ncol
If P(i, j).Interior.Color = coul Then ref(i) = 1: Exit For
Next
End If
Next
End If
Next
ref.AdvancedFilter xlFilterInPlace, [A8:A9]
MsgBox "Durée " & Format(Timer - t, "0.0 \s") 'mesure facultative
End Sub