créer feuilles portant le nom pris dans 'une liste

Sub CréerFeuilles()
Dim fbase As Worksheet
Dim Cell As Variant
Set fbase = Feuil1
'- on boucle
For Each Cell In fbase.Range("a1:a" & fbase.[a65000].End(xlUp).Row)
    If Cell.Value <> "" Then Worksheets.Add(after:=fbase).Name = Cell.Value
Next Cell
End Sub

Sub CréerFeuillesSansDoublon()
Dim fbase As Worksheet
Dim Cell As Variant, c As Variant
Dim d As Object
Set d = CreateObject("Scripting.dictionary")
Set fbase = Feuil1
'- on boucle
For Each Cell In fbase.Range("a1:a" & fbase.[a65000].End(xlUp).Row)
    If Cell.Value <> "" Then d(Cell.Value) = ""
Next Cell
'- on crée les feuilles
For Each c In d.keys: Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = c: Next
End Sub