XL 2013 Nommez tous les onglets d'un classeur par rapport à une même cellule dans chaque onglet

[Yuby]

Bonjour,

J'ai un Classeur A avec plusieurs onglets et je souhaite nommer tous ces onglets par rapport à une même cellule située dans l'onglet correspondant.
Exemple : Onglet 1 lui donner le même nom que la cellule E3 de l'onglet 1
Onglet 2 lui donner le même nom que la cellule E3 de l'onglet 2
Ect...
J'ai commencé une macro mais cela ne marche seulement lorsque je suis sur l'onglet.

Sub Nom_Onglet()

If Cells(3, 5) <> "" Then ActiveSheet.Name = Cells(3, 5) 'Correspond à la cellule A1

End Sub

Le problème vient de ActiveSheet.Name je pense mais je ne trouve pas la solution pour que ça fonctionne sur tous les onglets. Est-ce que quelqu'un serait m'aiguiller ?

Merci.

 

[halecs93]

Une solution en pj

 

[vgendron]

Hello

un essai de code à placer dans un module standard

Sub Renomme()


For Each ws In ActiveWorkbook.Sheets 'pour chaque feuille du classeur
    If ws.Range("E5") <> "" Then 'si il y a quelque chose en E5
        If Not FeuilleExiste(cstr(ws.Range("E5"))) Then 'si le nom n'a pas déjà été attribué à une autre feuille
            ws.Name = ws.Range("E5") "changement du nom de la feuille
        End If
    End If
Next ws
End Sub

Function FeuilleExiste(NomFeuille As String) As Boolean
FeuilleExiste = False
For Each ws In ActiveWorkbook.Sheets
    If ws.Name = NomFeuille Then
        FeuilleExiste = True
        Exit Function
    End If
Next ws

End Function

 

[Yuby]

Une solution en pj

Bonjour, je te remercie pour cette solution. Cependant, je dois mettre la formule dans toutes les feuilles pour que cela marche. Je voudrais créer un module et que cela marche sur toutes les feuilles sans avoir a mettre la macro sur chaque page

 

[Yuby]

Hello

un essai de code à placer dans un module standard

Sub Renomme()


For Each ws In ActiveWorkbook.Sheets 'pour chaque feuille du classeur
    If ws.Range("E5") <> "" Then 'si il y a quelque chose en E5
        If Not FeuilleExiste(cstr(ws.Range("E5"))) Then 'si le nom n'a pas déjà été attribué à une autre feuille
            ws.Name = ws.Range("E5") "changement du nom de la feuille
        End If
    End If
Next ws
End Sub

Function FeuilleExiste(NomFeuille As String) As Boolean
FeuilleExiste = False
For Each ws In ActiveWorkbook.Sheets
    If ws.Name = NomFeuille Then
        FeuilleExiste = True
        Exit Function
    End If
Next ws

End Function

Je te remercie beaucoup ça marche parfaitement !

 

[mapomme]

Bonjour à tous,

Un autre code à placer dans le module de ThisWorkbook :

Private Sub Workbook_Open()
   RenommerOnglet
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   RenommerOnglet Sh
End Sub

Sub RenommerOnglet(Optional xsh)
Dim x
   On Error GoTo NOK
   If IsMissing(xsh) Then
      For Each x In ThisWorkbook.Worksheets
         x.Name = x.Range("e3")
      Next x
   Else
      Set x = xsh
      x.Name = x.Range("e3")
   End If
   Exit Sub
 
NOK:
   MsgBox "Impossible de renommer la feuille : <" & x.Name & ">" & vbLf & vbLf & _
            "avec le nom <" & x.Range("e3") & ">", vbCritical
         Resume Next
End Sub