Code qui bloque Excel

[Freedal]

Bonjour,
j'ai insérer un code chaque feuilles d'un classeur (environ 50) pour renommer celles-ci automatiquement.
Sur une feuille synthèse ,il y a une liste de noms qui est renvoyer sur chaque feuilles en B2 qui doit donner ce nom à la feuille.
ça fonctionne très bien mais sur mon classeur avec toutes ses feuilles ça calcule sans cesse et excel est bloqué.
Merci de votre aide.
Voici le code :
Private Sub Worksheet_Calculate()
On Error Resume Next
Me.Name = Range("B2")
End Sub

 

[mapomme]

Bonsoir @Freedal

Un essai en supprimant toutes les macros de toutes les feuilles et en n'en mettant qu'une dans le module de la feuille "Synthése"

Private Sub Worksheet_Change(ByVal Target As Range)
' ne se lance que si des valeurs ont changées sur la feuille Synthèse
Dim xs

If Intersect(Target, Range("b:b")) Is Nothing Then Exit Sub
  'on va examiner toutes les cellules B2 des autres feuilles
  For Each xs In Worksheets
    'on vérifie qu'on est sur une autre feuille que "Synthése"
    If xs.CodeName <> Me.CodeName Then
      'on affecte le contenu de la cellule B2 au nom de l'onglet
      xs.Name = xs.Range("b2").Value
    End If
  Next xs
End Sub

 

[Freedal]

Bonjour mapomme et merci pour ta réponse, j'ai tardé à te répondre car ton code fonctionne
exellemment bien sur ce classeur mais quand je le met sur le classeur définitif fonctionne mal
car le classeur définitif Il y a des feuilles qui sont vides en B2 ou qui contiennent d'autres valeurs et qui n'ont rien à voir avec la feuille "Synthése".
Merci encore.

 

[mapomme]

Bonjour @Freedal

car le classeur définitif Il y a des feuilles qui sont vides en B2 ou qui contiennent d'autres valeurs et qui n'ont rien à voir avec la feuille "Synthése".

ça ne fonctionne pas mal. C'est que ce n'était pas prévu pour...
Voici la version v2 qui devrait résoudre le cas évoqué.

Private Sub Worksheet_Change(ByVal Target As Range)
' ne se lance que si des valeurs ont changées sur la feuille Synthèse
Dim xs, plageColB As Range, CelluleSource As Range, ErrPrem As Boolean

If Intersect(Target, Range("b:b")) Is Nothing Then Exit Sub
  'plage de la colonne B de la feuille Synthése"
  With Sheets("Synthése")
  Set plageColB = .Range("b4:b" & Rows.Count): End With
  ' on va examiner toutes les cellules B2 des autres feuilles
  For Each xs In Worksheets
    ErrPrem = False     'pas d 'erreur au départ
    ' on vérifie qu'on est sur une autre feuille que "Synthése"
    If xs.CodeName <> Me.CodeName Then
      ' on vérifie que la formule de type =Synthése!Bnn
      ' référence bien une cellule de la colonne B de la feuille "Synthése"
      On Error GoTo errFORMULE
      Set CelluleSource = Range(Mid(xs.Range("b2").Formula, 2, 999))
      If Not ErrPrem Then
        If Not Intersect(CelluleSource, plageColB) Is Nothing Then
          ' la cellule source de B2 est bien dans plageColonneA
          On Error GoTo errRENOMMER
          'on affecte le contenu de la cellule B2 au nom de l'onglet
          xs.Name = xs.Range("b2").Value
        End If
      End If
    End If
  Next xs
  Exit Sub
 
errFORMULE:
  ErrPrem = True
  Resume Next
 
errRENOMMER:
  'mettre l'instruction Msgbox en commentaire si vous ne voulez pas de msg
  MsgBox "Erreur n°: " & Err.Number & vbLf & Err.Description & vbLf & vbLf & _
    "La feuille: <" & xs.Name & " > n'a pas pu être renommée", vbCritical
  Resume Next   ' Conservez cette instruction
End Sub

 

[Freedal]

Bonjour mapomme,
Exellent comme le code précédent, avec celui-ci j'avais feinté : sur chaque feuille de mon classeur définitif, j'ai une colonne A qui est masquée , et en A1 sur les feuilles dont le nom n'apparait pas sur "Synthése" j'avais juste mis une lettre et sur les feuilles qui apparaissent dans "Synthése" j'avais mis "=B2" et ça fonctionnait trés bien mais tu m'as apporté une autre solution, direct, clair et précis.
Je ne connais pas ton profil mais je pense que tu es un artiste en la matiére et je te dis un grand merci.
ça fait plusieurs année que j'améliore un classeur de gestion et il ne me manquait que cela pour arriver à mon but ,à mon niveau bien sur.
Quand je change un intitulé sur synthése, ça rame un peu,le fichier est lourd et l'ordi n'est pas récent.
Merci encore et bon week-end.