Sub aEssai()
Dim t0!, t1!
init
DoEvents
t0 = Timer
Essai
t1 = Timer
Feuil1.Activate
MsgBox t1 - t0 - 86400 * (t1 < t0)
End Sub
Sub Essai()
Dim R As Range, Rcode As Range, d As Object, tCode, i&, dk, di, pl&, Dlig&, Plig&
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Temp"
Sheets("Données").[A1].CurrentRegion.Copy Sheets("temp").[A1]
Set R = Sheets("temp").[A1].CurrentRegion
With Worksheets("Temp").Sort
.SortFields.Clear
.SortFields.Add Key:=R.Columns(2) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
.SetRange R.Columns(2)
.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
Plig = 1: Dlig = di(0)
For i = 0 To UBound(dk)
On Error Resume Next
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = dk(i)
With Sheets(dk(i))
.Cells(1, 1) = "NOM": .Cells(1, 2) = "CODE": .Cells(1, 3) = "ADRESSE"
Sheets("temp").Range(Sheets("temp").Cells(Plig, 1), Sheets("temp").Cells(Dlig, 3)).Copy Sheets(dk(i)).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