Sub extraction_CCCT()
Dim CCCT As String
CCCT = "CCCT"
Call VerrouDesactive
Call RetablirCopierCouper_DragAndDrop
Sheets("Contacts").Range("$D$2:$AF$650000").AutoFilter Field:=1, Criteria1:=CCCT
ActiveSheet.Copy
ChDir "C:\"
Application.Dialogs(xlDialogSaveAs).Show "Extrait_Contacts_CCCT" & "_" & "Sem" & " - " & Day(Date) & "-" & Month(Date) & "-" & Year(Date) & ".xlsx"
Call InterdireCopierCouper
Call VerrouActivate
End Sub