nommer une feuille avec une cellule

Private Sub Worksheet_Calculate()
on error Resume Next
If Me.Name <> Range("J2") And Not IsNull(Range("J2").Text) Then Me.Name = Range("J2")
End Sub
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Address <> "$J$2" Or IsNumeric(Target.Value) Then Exit Sub
If Me.Name <> Range("J2") And Not IsNull(Range("J2").Text) Then Me.Name = Range("J2")
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
'si A1 est renseigné manuellement
On Error Resume Next
Sh.Name = Sh.[A1]
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
'si A1 contient une formule
On Error Resume Next
Sh.Name = Sh.[A1]
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
'si A1 est renseigné manuellement
On Error Resume Next
Sh.Name = Sh.[A1]
If Err And Sh.[A1] <> "" Then _
  MsgBox "La feuille '" & Sh.Name & "' ne peut être nommée '" & Sh.[A1] & "'...": _
    Application.Undo 'annule la modification
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
'si A1 contient une formule
On Error Resume Next
Sh.Name = Sh.[A1]
If Err And Sh.[A1] <> "" Then _
  MsgBox "La feuille '" & Sh.Name & "' ne peut être nommée '" & Sh.[A1] & "'...": _
    Application.Undo 'annule la modification
End Sub

Private Sub Workbook_Open()
'définit le nom cible pour chaque feuille
Dim w As Worksheet
For Each w In Worksheets
  On Error Resume Next
  Set w = w.Names("cible").Parent
  'si le nom existe on n'y touche pas
  If Err Then w.Names.Add "cible", w.[B6]
  'facultatif, si on veut masquer le nom
  'w.Names("cible").Visible = False
Next
End Sub

    Dim w As Worksheet
    For Each w In ThisWorkbook.Worksheets
        w.Name = w.[Mot]
    Next