Sub zebanx()
Dim DerLig As Long, MonDico, Tableau, i As Integer, NomFichier As String
Dim WS1 As Worksheet, WS2 As Worksheet
Set MonDico = CreateObject("Scripting.Dictionary")
Set WS1 = Worksheets("brut")
If Not WS1.AutoFilterMode Then WS1.Range("A1:H1").AutoFilter
DerLig = WS1.Range("A" & Rows.Count).End(xlUp).Row
'récupération des noms de type sans doublon
Tableau = WS1.Range("A2:A" & DerLig)
For i = LBound(Tableau) To UBound(Tableau)
If Tableau(i, 1) <> "" Then MonDico(Tableau(i, 1)) = ""
Next i
Erase Tableau
Tableau = MonDico.keys
' pour chaque type
For i = LBound(Tableau) To UBound(Tableau)
'si la feuille du type n'existe pas on la crée
If ChercheFeuille(Tableau(i)) = False Then
Sheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Tableau(i)
End If
Set WS2 = Worksheets(Tableau(i))
WS2.Cells.Delete 'effacement de la feuille de destination
WS1.Range("A1:H" & DerLig).AutoFilter Field:=1, Criteria1:=Tableau(i) 'tri la feuille selon le type
WS1.Range("A1:H" & DerLig).SpecialCells(xlCellTypeVisible).Copy WS2.Range("A1") 'copie sur la feuille du type
If Not WS2.AutoFilterMode Then WS2.Range("A1:H1").AutoFilter
Application.CutCopyMode = False
Next
WS1.ShowAllData
End Sub
Function ChercheFeuille(NomFeuille)
For i = 1 To Worksheets.Count
If Worksheets(i).Name = NomFeuille Then
ChercheFeuille = True
Exit Function
End If
Next
ChercheFeuille = False
End Function