Sub Essai2()
Dim R As Range, Rcode As Range, d As Object, tCode, i&, dk, di, pl&, Dlig&, Plig&, NbCol&
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Temp"
Sheets("Données").Cells(1, 1).CurrentRegion.Copy Sheets("temp").Cells(1, 1)
Set R = Sheets("temp").Cells(1, 1).CurrentRegion
NbCol = R.Columns.Count
With Worksheets("Temp").Sort
.SortFields.Clear
.SortFields.Add Key:=R.Columns(2) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
.SetRange R 'suite à la remarque de Roger
.Header = xlYes
.Apply
End With
Sheets("temp").Rows(1).Delete
Set Rcode = R.Columns(2)
tCode = Rcode
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(tCode): d(CStr(tCode(i, 1))) = d(CStr(tCode(i, 1))) + 1: Next
dk = d.Keys: di = d.Items
ReDim Preserve di(UBound(di) + 1)
Plig = 1: Dlig = di(0)
For i = 0 To UBound(dk)
On Error Resume Next: Sheets(dk(i)).Delete: On Error GoTo 0
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = dk(i)
With Sheets(dk(i))
Sheets("Données").Cells(1, 1).Resize(1, NbCol).Copy .Cells(1, 1)
Sheets("temp").Cells(Plig, 1).Resize(Dlig - Plig + 1, NbCol).Copy .Cells(2, 1)
End With
Plig = Dlig + 1: Dlig = Dlig + di(i + 1)
Next i
Sheets("temp").Delete
Application.ScreenUpdating = True: Application.DisplayAlerts = True
End Sub