Private Sub Worksheet_Activate()
Dim ncol%, source As Range, dest As Range, t, i&
ncol = 7 'nombre de colonnes, à adapter
Set source = Feuil1.[B2].CurrentRegion.Columns(9) 'à adapter
Set dest = [B4].CurrentRegion.Resize(, ncol) 'à adapter
Application.ScreenUpdating = False
'---remplissage de la 2ème colonne---
t = dest.Resize(, 2) 'matrice, plus rapide
For i = 1 To UBound(t)
t(i, 2) = Application.CountIf(source, t(i, 1)) 'NB.SI
Next
dest.Columns(2) = Application.Index(t, , 2)
'---tri décroissant sur la 2ème colonne---
dest.Sort dest(1, 2), xlDescending, Header:=xlNo 'pas de titres
dest.Columns(2).Replace 0, "#N/A", xlWhole
'---couleur---
dest.Interior.Color = vbYellow 'jaune
'---effacements---
On Error Resume Next 'si aucun #N/A
With Intersect(dest, dest.Columns(2).SpecialCells(xlCellTypeConstants, 16).EntireRow)
.Interior.ColorIndex = xlNone
.Columns(2).ClearContents
End With
End Sub