Nom onglget = valeur cellule

'Déclaration des variables : Cel permet de scruter l'ensemble des cellules de la colonne D2 à Dmax 
Dim Cel As Range
'Lg contiendra la derniére ligne écrite de la colonne D
dim Lg&

'Là on référence la feuille Chambre froide et vitrine , ATTENTION dans le dernier classeur joint la feuille est renommée Affich je crois 
'Donc si c'est le cas il faudra modifier ici le nom également 
With Worksheets("Chambre froide et vitrine ")
  'Là, Trouve la dernière ligne renseignée de la colonne D en remontant depuis la derniere ligne feuille maxi
  'Attention le With met en référence un objet , ici la feuille en question, le .range suivant est donc défini dans cette meme feuille   
   Lg = .Range("D" & Rows.Count).End(xlUp).Row
  'Ici la boucle each scrute l'ensemble des cellules de la zone D2:Dmax 
  For Each Cel In .Range("D2:D" & Lg)
   'Ajout d'une feuille en fin de classeur  
    Worksheets.Add after:=Sheets(Sheets.Count)
   'Renommage de la feuille suivant le nom de la cellule
     ActiveSheet.Name = Cel.Text
 'Si dernier élement non atteind , alors l'on reprend la boucle for en incrémentant de 1 l'adresse de la cellule scrutée
 Next Cel
'Fin de mise en référence
End With
End Sub

Option Explicit

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
traitement Sh
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address = Sh.Range("D1").Address Then
    traitement Sh
End If
End Sub
Private Sub traitement(Sh As Worksheet)
Dim Reponse$
    If TestOnglet(Sh.Range("D1").Text) = True And Sh.Range("D1").Text <> Sh.Name Then Reponse = InputBox("Indiquez un nom d'onglet valable", "Nom d'onglet déjà utilisé", Sh.Range("D1").Text)
        Reponse = IIf(Reponse = "", Sh.Range("D1"), Reponse)
        On Error Resume Next
        Sh.Name = Reponse
End Sub
Private Function TestOnglet(zz As String) As Boolean 'fonction Test
 On Error Resume Next
 TestOnglet = Sheets(zz).Name <> ""
 On Error GoTo 0
 End Function