Sub b()
Dim ws As Worksheet, pf As Range, pcopy As Range, dl&, The_Crit$
The_Crit = InputBox("Saisir le critère", "Synthétisons, crénom!", "AA")
For Each ws In Worksheets
If Len(ws.Name) = 2 Then
ws.Range("$B$10:$W$21").AutoFilter 8, The_Crit
Set pf = ws.[_FilterDatabase]
Set pcopy = pf.Offset(1, 0).Resize(pf.Rows.Count - 1).SpecialCells(12)
dl = Sheets("Synthese").Cells(Rows.Count, "I").End(3).Row
pcopy.Copy Sheets("Synthese").Cells(dl + 1, "B")
ws.AutoFilterMode = False
End If
Next
End Sub