Sub CreationFeuilleParNom()
Dim wsListe As Worksheet, wsModele As Worksheet, wsTest As Worksheet
Dim i As Integer, Der As Integer
Dim Noms As Variant, tbl As Variant
Application.ScreenUpdating = False
With ThisWorkbook
Set wsListe = .Sheets("Liste")
Set wsModele = .Sheets("Modèle")
End With
With wsListe.Range("A3").CurrentRegion
Noms = .Offset(1).Resize(.Rows.Count - 1).Columns(2)
End With
Der = UBound(Noms)
For i = Der To 1 Step -1
'
' Tester si la feuille existe déjà
Set wsTest = ThisWorkbook.Sheets(Noms(i, 1))
'
' Si elle n'existe pas on la crée
If wsTest Is Nothing Then
wsModele.Copy After:=wsListe
With ActiveSheet
' Nom de la feuille
.Name = Noms(i, 1)
' Eclater le nom
tbl = Split(Noms(i, 1), " ")
' premier élément en E7 et dernier en E37
.Range("E7") = tbl(0)
.Range("E37") = tbl(UBound(tbl))
End With
End If
Set wsTest = Nothing
Next i
Application.ScreenUpdating = True
End Sub