Sub Creation_Onglets()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Détermine la dernière dernière cellule de la dernière colonne (renvoi du style $P$5)
dercol = Range("A1").SpecialCells(xlCellTypeLastCell).Address
'Détermine le numéro de la dernière colonne
numcol = Cells(1, Columns.Count).End(xlToLeft).Column
'Création du nom défini Base
Range("A1:" & dercol).Name = "Base"
'Création des noms d'intitulés
Cells(1, 1).Name = "Titre1"
Range(Cells(1, 2), Cells(1, numcol)).Name = "Titre2"
'Suppression de toutes les feuilles sauf la 1ère
For i = Sheets.Count To 2 Step -1
Sheets(i).Delete
Next i
'Boucle sur toutes les lignes remplies de la colonne A - A partir de A2
Set Onglet = CreateObject("Scripting.Dictionary")
For Each cel In Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
'Mise en mémoire des noms des onglets à créer
If Not Onglet.Exists(cel.Value) Then Onglet.Add cel.Value, cel.Value
Next cel
'Boucle sur toutes les noms en mémoire et création de la feuille
For Each It In Onglet.items
NouvelleFeuille = Onglet.Item(It)
On Error Resume Next
Set connue = Sheets(NouvelleFeuille)
If Err <> 0 Then Sheets.Add.Name = NouvelleFeuille
On Error GoTo 0
'Avec la feuille créée
With Sheets(NouvelleFeuille)
'On copie les valeurs des intitulés
.Cells(3, 1).Value = Range("Titre1").Value
.Cells(3, 3).Value = NouvelleFeuille
.Range(Cells(5, 1), Cells(5, numcol)).Value = Range("Titre2").Value
'Dans la cellule IV1, on écrit n° affaire (valeur de A1 dans la feuille SAISIE)
.[IV1] = "n° affaire"
'Dans la cellule IV2, on écrit le nom de la feuille créée
.[IV2] = NouvelleFeuille
'Extraction des données de la Base (nom défini)selon les critères inscrits en IV1 et IV2 que l'on copie à partir de A5:O5
Range("Base").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
"IV1:IV2"), CopyToRange:=.Range("A5:O5"), Unique:=False
'Effacement des valeurs dans les cellules IV1:IV2
.[IV1:IV2].ClearContents
End With
'On passe à la feuille suivante
Next It
'On place la feuille SAISIE en 1ère feuille
Sheets("SAISIE").Move Sheets(1)
'On affiche la feuille SAISIE
Sheets("SAISIE").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub