Sub extraire_les_DEPQ()
Application.ScreenUpdating = False
Dim critere(1 To 4) As String
Dim Compteur As Long
Dim Derlig As String
Derlig = Sheets(1).Range("A65536").End(xlUp).Row
Compteur = 2
critere(1) = "D"
critere(2) = "E"
critere(3) = "P"
critere(4) = "Q"
For i = 2 To Derlig
With Sheets(1)
If left(Cells(i, 1), 1) = critere(1) _
Or left(Cells(i, 1), 1) = critere(2) _
Or left(Cells(i, 1), 1) = critere(3) _
Or left(Cells(i, 1), 1) = critere(4) Then
Sheets(1).Range(Cells(i, 1), Cells(i, 3)).Copy Destination:=Range("3!A" & Compteur)
Compteur = Compteur + 1
End If
End With
Next i
End Sub