Sub Transfert()
'
Chemin = ActiveWorkbook.Path
With ActiveWorkbook.Worksheets("BD")
Mafeuille = .Name
.Range("E1:F1").Copy Destination:=.Range("K1")
.Range("K2").Value = "OUI"
.Range("L2").Value = "NON"
.Range("A1:F1").Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Workbooks("TransfèreDonnées2.xlsm").Sheets("BD").Columns("A:F").AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=Workbooks("TransfèreDonnées2.xlsm"). _
Sheets(Mafeuille).Range("K1:L2"), CopyToRange:=Columns("A:F"), Unique:=False
Columns("A:F").EntireColumn.AutoFit
ActiveWorkbook.SaveAs Filename:=Chemin & "\Extrait.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
.Range("K1:L2").ClearContents
End With
End Sub