Sub filtre()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim fSrc As Worksheet, tmpS As Worksheet
Dim new_name$, i&, nb_filtre%
Set fSrc = ThisWorkbook.Sheets("Feuil1")
Tb_c = fSrc.Cells(1, fSrc.Columns.Count).End(xlToLeft).Column
nb_filtre = InputBox("Entrer la valeur seuil", "Filtre petites tailles")
new_name = "Filtre_" & nb_filtre
Sheets.Add.Name = new_name
Set tmpS = Sheets(new_name)
For i = 1 To Tb_c
Tb_c_temp = tmpS.Cells(1, fSrc.Columns.Count).End(xlToLeft).Column + 1
tmpS.Cells(1, Tb_c_temp) = fSrc.Cells(1, i)
tmpS.Cells(2, Tb_c_temp) = ">" & nb_filtre
fSrc.Columns(i).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=tmpS.Range(Cells(1, Tb_c_temp), Cells(2, Tb_c_temp)), CopyToRange:=tmpS.Cells(1, Tb_c_temp + 1), Unique:=False
tmpS.Columns(Tb_c_temp).Delete
Next i
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub