Sub Creation_Feuilles()
Dim F As Worksheet, i&, d As Object, P As Range, ncol%, j%, x$, k%, lig&
Set F = Sheets("Planning")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---suppression des feuilles---
F.Move Before:=Sheets(1)
For i = Sheets.Count To 2 Step -1
Sheets(i).Delete
Next i
'---création et remplissage des feuilles---
Set d = CreateObject("Scripting.Dictionary")
Set P = F.[B2].CurrentRegion 'à adapter
ncol = P.Columns.Count
For i = 2 To P.Rows.Count
For j = 4 To 6 'colonnes à adapter
x = Application.Proper(Trim(P(i, j))) 'NOMPROPRE
If x <> "" Then
If Not d.exists(x) Then
Sheets.Add After:=Sheets(1)
Sheets(2).Name = x
For k = Sheets.Count To 3 Step -1
If x > Sheets(k).Name Then Sheets(x).Move After:=Sheets(k): Exit For 'classement des feuilles
Next k
With Sheets(x)
For k = 1 To ncol
.Columns(k).ColumnWidth = P(1, k).ColumnWidth 'largeurs des colonnes
Next
P.Rows(1).Copy .Cells(1)
End With
End If
d(x) = d(x) + 1
lig = d(x) + 1
With Sheets(x).Cells(lig, 1)
P.Rows(i).Copy .Cells
.Value = P(i, 1) 'remplace la formule par la valeur
With .Resize(, ncol).Interior
If lig Mod 2 Then .ColorIndex = xlNone Else .Color = RGB(221, 235, 247) 'bleu clair
End With
End With
End If
Next j, i
F.Activate
End Sub