Private Sub CommandButton1_Click()
Sheets("Sheet1").Select
'----------------------------------------------
' suppression de lignes blanches
'----------------------------------------------
l = 11
While nb_lb < 5
If Cells(l, 8) = "" Then
nb_lb = nb_lb + 1
Rows(l).Delete
Else
nb_lb = 0
l = l + 1
End If
Wend
critere = InputBox("Critere?")
If critere = "" Then Exit Sub
[A10].AutoFilter Field:=7, Criteria1:="*" & critere & "*"
Application.DisplayAlerts = False
On Error Resume Next
'--------------------- création nouvelle feuille
Sheets(critere).Delete
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = critere
Sheets("Sheet1").Select
l = 11
While Cells(l, 8) <> ""
l = l + 1
Wend
Rows("11:" & l - 1).Select
Selection.Copy
Sheets(critere).Select
ActiveSheet.Paste
Cells.EntireColumn.AutoFit
Sheets("Sheet1").ShowAllData
End Sub