Sub test2()
Dim NDF As String, rep As String
Dim Wsource As Workbook, Wcible As Workbook
Application.ScreenUpdating = False
Set Wsource = ThisWorkbook
'Gestion dossier et classeur
rep = ThisWorkbook.Path & "\TEST\"
If Dir(rep, vbDirectory) = "" Then MkDir rep
NDF = rep & "toto.xlsx"
If Dir(NDF) <> "" Then Kill (NDF)
Workbooks.Add
Set Wcible = ActiveWorkbook
'Si nécessaire ajouter une feuille
'Wcible.Sheets.Add
'Filtre Base vers FET UCE
With Wsource.Worksheets("FET UCE")
Wsource.Sheets("Base").Columns("A:O").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("N1:Q2"), CopyToRange:=.Range("D8:P8"), _
Unique:=False
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("E8"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=.Range("F8"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SetRange .Cells(8, 5).CurrentRegion
.Sort.Header = xlYes
.Sort.MatchCase = False
.Sort.Orientation = xlTopToBottom
.Sort.Apply
'Copie FET UCE
.Cells(4, 5).CurrentRegion.Copy Destination:=Wcible.Worksheets(1).Cells(1, 2)
If .Range("E9") <> "" Then
.Cells(8, 5).CurrentRegion.Copy Destination:=Wcible.Worksheets(1).Cells(4, 1)
Else
Wcible.Worksheets(1).Cells(4, 1) = "NO PROBLEMO"
End If
End With
Wcible.Worksheets(1).Name = "TEST 1"
'Placer ici les autres filtres et copies en changeant de feuille cible
Wcible.SaveAs Filename:=NDF
Application.ScreenUpdating = True
End Sub