Sub Supprime_Feuilles()
Dim w As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each w In Worksheets
If IsNumeric(w.Name) Then w.Delete
Next
End Sub
Sub Cree_Feuilles()
Dim d As Object, P As Range, a, i&, x$
'---supression des feuilles---
Supprime_Feuilles
'---liste des feuilles---
Set d = CreateObject("Scripting.Dictionary")
With Sheets("extraction")
If .FilterMode Then .ShowAllData 'si la feuille est filtrée
Set P = .Range("A4:U" & .Range("C" & .Rows.Count).End(xlUp).Row)
If P.Row < 4 Or P.Rows.Count < 2 Then Exit Sub
End With
P.Sort P(1, 21), xlDescending, Header:=xlYes 'tri sur la colonne U
a = P.Columns(3)
For i = 2 To UBound(a)
x = a(i, 1)
If x <> "" Then d(x) = ""
Next
a = d.keys
tri a, 0, UBound(a)
'---création des feuilles---
For i = 0 To UBound(a)
Sheets.Add After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = a(i)
P.AutoFilter 3, a(i)
P.Copy .Cells(1)
.Columns.AutoFit
End With
Next
P.AutoFilter 3
Sheets(a(0)).Select
End Sub
Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
Do While a(g) < ref: g = g + 1: Loop
Do While ref < a(d): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub