Option Compare Text 'la casse est ignorée
Private Sub Worksheet_Activate()
Dim critere$, resu, i&, nom$, w As Worksheet, tablo, j&, k%
critere = [B3]
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A5].CurrentRegion.Resize(, 2)
resu = .Value 'matrice, plus rapide
For i = 2 To UBound(resu)
nom = resu(i, 1)
resu(i, 2) = 0
For Each w In Worksheets
If w.Name Like "S#*" Then
tablo = w.Range("A6").CurrentRegion 'matrice, plus rapide
For j = 2 To UBound(tablo)
If tablo(j, 1) = nom Then
For k = 2 To UBound(tablo, 2)
If tablo(j, k) = critere Then resu(i, 2) = resu(i, 2) + 1
Next k
End If
Next j
End If
Next w, i
.Columns(2) = Application.Index(resu, , 2) 'restitution
End With
End Sub