Sub extraction()
Dim c As Range
Dim box As String
Dim derlig As Long
box = InputBox("Saisie du numero de palette : ", "Palette")
If box <> "" Then
With Sheets("Liste")
With ActiveSheet
If Not .AutoFilterMode Then .Range("B1").AutoFilter
End With
'la ligne de la dernière cellule remplie de la colonne B de feuille Base
derlig = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range("B2:B" & derlig)
'On filtre sur la colonne 2 de la feuille Liste, en prenant comme critère la valeur de box
.AutoFilter Field:=2, Criteria1:=box
'On copie les lignes issues du filtre auto
.SpecialCells(xlCellTypeVisible).EntireRow.Copy
End With
'On enlève notre filtre automatique
.AutoFilterMode = False
End With
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Paste
ActiveSheet.Name = Range("B2")
Columns.AutoFit
End If
End Sub