Sub CreerFeuilles()
Dim a, S As Worksheet, n%, der%, t, i&, gauche%, j&
a = Array("Base", "Feuil2", "Feuil3") 'noms des feuilles à ne pas supprimer, à adapter
Set S = Sheets(a(0)) 'feuille source, à adapter
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
'---supprime les feuilles---
For n = Sheets.Count To 1 Step -1
If IsError(Application.Match(Sheets(n).Name, a, 0)) Then Sheets(n).Delete
Next
n = Sheets.Count: der = n
'---crée les feuilles---
t = S.UsedRange.Resize(, 2) 'au moins 2 éléments
For i = 1 To UBound(t)
If t(i, 1) Like Val(t(i, 1)) & ".*" Then
With Sheets.Add(After:=Sheets(n))
For gauche = 31 To 1 Step -1 'le nom d'une feuille ne doit pas avoir plus de 31 caractères
.Name = Left(t(i, 1), gauche)
If .Name = Left(t(i, 1), gauche) Then Exit For 's'il n'y a pas de caractères interdits
Next
End With
If n > der Then S.Rows(j & ":" & i - 1).Copy Sheets(n).[A1]: Sheets(n).Columns.AutoFit
j = i
n = n + 1
End If
Next
S.Rows(j & ":" & i).Copy [A1]: Columns.AutoFit
S.Select
End Sub