Private Sub CommandButton1_Click() 'bouton "Extract"
Const cr As String = "modif /neuf" 'définit la constante cr (CRitère)
Dim pad As Range 'définit la variable pad (Plage des Anciennes Données)
Dim dl As Integer 'définit la variable dl (Dernière Ligne)
Dim pl As Range 'définit la variable pl (PLage)
Dim cel As Range 'définit la variable cel (CELlule)
Dim dest As Range 'définit la variable dest (cellule de DESTination)
Application.ScreenUpdating = False 'masque les changements à l'écran
ActiveCell.Select 'enlève le focus au bouton
Set pla = Range("A2").CurrentRegion 'définit la plage des anciennes données pla
If pla.Rows.Count > 1 Then 'condition si pla contient des données
Set pla = pla.Offset(1, 0).Resize(pla.Rows.Count - 1, pla.Columns.Count) 'redéfinit pla
pla.Clear 'supprime les anciennes données
End If 'fin de la condition
With Sheets("Feuil1") 'prend en compte l'onglet "Feuil1"
dl = .Cells(Application.Rows.Count, 1).End(xlUp).Row 'de'finit la dernière ligne éditée dl de la colonne 1 (=A)
Set pl = .Range("A1:T" & dl) 'définit la plage pl
.Range("A1").AutoFilter 'lance le filtre automatique
.Range("A1").AutoFilter , Field:=8, Criteria1:=cr 'filtre la colonne 8 (=H) en fonction du critère cr
For Each cel In Application.Intersect(pl.SpecialCells(xlCellTypeVisible), .Columns(4)) 'boucle sur toutes les cellules visible cel de la colonne 4 (=D)
Set dest = Sheets("Feuil2").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest
'si le département est 22 ou 29 ou 35 ou 56, copie et colle la ligne de cel dans dest
If cel.Value = 22 Or cel.Value = 29 Or cel.Value = 35 Or cel.Value = 56 Then cel.EntireRow.Copy dest
Next cel 'prochaine cellule de la boucle
.Range("A1").AutoFilter 'annule le filtre automatique
End With 'fin de la prise en compte de l'onglet "Feuil1"
Application.ScreenUpdating = True 'affiche les changements à l'écran
If Range("A2").CurrentRegion.Rows.Count = 1 Then MsgBox "Aucune donnée ne correspond aux critères !" 'message si pas d'extraction
End Sub