Sub TriICD()
Dim MonDico As Object
Dim i As Integer, NbLg As Long, J As Long
Dim Chemin As String
Dim Tablo
Application.ScreenUpdating = False
Chemin = ThisWorkbook.Path & Application.PathSeparator
With Sheets("ICD")
If .FilterMode = True Then .ShowAllData
.Range("AE1") = .Range("B1") ' Prépares l'entête de la zone critère
NbLg = .Range("B" & Rows.Count).End(xlUp).Row
Set MonDico = CreateObject("Scripting.dictionary")
For J = 2 To NbLg
MonDico(.Range("B" & J).Value) = ""
Next J
Tablo = MonDico.keys
If Sheets.Count <> 3 Then
Sheets.Add(after:=Sheets(1)).Name = "Feuil1"
Sheets.Add(after:=Sheets(1)).Name = "Feuil2"
End If
For i = 0 To UBound(Tablo)
.Range("AE2") = Tablo(i)
.Range("A1:AB" & NbLg).AdvancedFilter Action:=xlFilterCopy, criteriarange:=.Range("AE1:AE2"), copytorange:=Sheets("Feuil2").Range("A1:AB1")
Sheets("Feuil2").DrawingObjects.Delete
Sheets("Feuil2").Copy
With ActiveWorkbook
.Sheets(1).Name = Tablo(i)
Call ExportationToron
.SaveAs Chemin & Tablo(i) & ".xlsx"
.Close
End With
Next i
.Range("AE1:AE2").ClearContents
End With
Sheets("Feuil2").Cells.Clear
MsgBox "Création des " & MonDico.Count & " fichiers terminée"
End Sub