Sub eclater()
Dim Sh As Worksheet
Dim Cel As Range
Dim Numeros As Object
Dim It
Dim DerLig As Long
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
For Each Sh In Sheets
If Sh.Name <> "base" Then Sh.Delete
Next Sh
Set Numeros = CreateObject("Scripting.Dictionary")
With Sheets("base")
DerLig = .[A65000].End(xlUp).Row
.Range("A1:D" & DerLig).Name = "mabase"
For Each Cel In .Range("A2:A" & DerLig)
Numeros(Left(Cel, 2)) = Left(Cel, 2)
Next Cel
For Each It In Numeros.Items
.Range("K2").FormulaR1C1 = "=LEFT(RC[-10],2)*1=" & It
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Tableau " & It
.Range("mabase").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("K1:K2"), _
CopyToRange:=Range("A1"), Unique:=False
Next It
.[K2].Clear
.Select
End With
End Sub