Rename onglet avec texte fixe & valeur de cellule

Bonjour à toutes et tous,

Mes meilleurs vœux pour 2022 et prenez soin de vous.

J'essaye en vain de renommer des onglets suivant un texte fixe ("Synthèse" dans ce cas) suivi d'une valeur de cellule.

Après recherches, j'ai essayé d'adapter cette solution mais qui vraisemblablement ne fonctionne pas dans mon cas (je me suis sûrement planté quelque part):

Sub rename()

Dim ws As Worksheet
Dim ws1 As Worksheet
Dim strErr As String

On Error Resume Next
For Each ws In ActiveWorkbook.Sheets
Set ws1 = Sheets(ws.Synthèse & "_B1")
    If ws1 Is Nothing Then
        ws.Name = ws.Synthèse & "_B1"
    Else
        strErr = strErr & ws.Synthèse & "_B1" & vbNewLine
    End If
Set ws1 = Nothing
Next
On Error GoTo 0

If Len(strErr) > 0 Then MsgBox strErr, vbOKOnly, "these sheets already existed"

End Sub

Le besoin concerne les feuilles 2-9 et 12 du fichier joint.

Je m'en remets à votre expertise.

D'avance merci.

bonne soirée

Bonjour,

Voici un essai si j'ai bien compris :

Sub ChangeWsNames()
dim ws as worksheet, sNewname$, strErr$
for each ws in worksheets
    sNewname = "Synthese_" & ws.range("B1").value
    if IsValid(sNewname) then
        if not wsexists(sNewname) then
            ws.name = sNewname
        else
            strErr = strErr & vblf & "- " & sNewname & " existe déjà"
        end if
    else
        strErr = strErr & vblf & "- " & sNewname & " n'est pas un nom valide"
    end if
end with
if strErr <> "" then msgbox "Rapport d'erreurs :" & vblf & strErr, vbinformation
end sub

function WsExists(Name as string) as boolean
on error resume next
WsExists = worksheets(Name).index
end function

function IsValid(Name as string) as boolean
on error resume next
with activesheet
    temp = .name
    .name = Name
    if err <> 1004 then IsValid = true
    .name = Name
end with
end function

Cdlt,

Bonjour,

1) La macro pour renommer doit se trouver dans un module pas dans chaque feuille.

On écrit une macro dans une feuille quand il y a un évènement déclencheur dans cette feuille.

2) Vous devez faire en sorte que la macro fonctionne pour toutes les feuilles concernées et pas écrire 3 macros différentes.

3) Il faut utiliser ce qui est commun à vos feuilles : elle commence toutes par : "Synthèse" ...

Donc

Sub rename()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
If ws.Name Like "Synthèse*" Then
ws.Name = "Synthèse" & "_" & ws.Range("B1").Value
End If
Next ws
End Sub

... Sauf si j'ai pas compris alors c'est la solution de 3BG que je salue en passant

Bonjour,

Merci pour vos réponses et votre intérêt.

J'ai essayé vos solutions toutefois celles-ci ne semblent pas fonctionner dans mon tableau.

Pour répondre à Xmenpl, j'ai opté pour le codage dans les feuilles concernées (2-9-12) car l'élément déclencheur ci trouve (cellule B1).

A ce stade je n'ai pas solutionné mon besoin car mes tentatives ne fonctionnent pas.

Cordialement

non : Sub rename() et B1 dans une feuille n'est pas un évèvement déclencheur de la macro

L'évènement sur une feuille serait par exemple : "si contenu feuille change"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Mais dans votre cas celà est inutile puisque la macro dans un module peut le faire pour tous les onglets.

Le fichier retourné dans mon précédent post fonctionne si vous lancez la macro.

Bonsoir X-Men,

Effectivement en lançant ta macro cela fonctionne.

Toutefois, je cherche à ce que l'action de renommage se fasse automatiquement lors de la saisie des valeurs dans l'onglet Master (cellules F5 - 6 et 7).

Je reporte ces valeurs de cellules en 'B1' dans les feuilles 2,9 et 12 (raison pour laquelle je voulais renommer à partir de cette action).

Ton codage pourrais-t-il agir de manière automatique lors des changements de valeurs en onglet Master ou pas?

Cordialement.

Oui il vous avez déjà un événement sur la feuille "Master". Il suffit d'appeler la macro du module ( "rename") dans votre code : call rename juste avant la fin du code

Private Sub Worksheet_Change(ByVal Target As Range)
   If Intersect(Target, Range("F5:F8")) Is Nothing Or Target.Cells.Count > 2 Then Exit Sub
        Application.EnableEvents = False
    Select Case Target.Address
    Case "$F$5": Sheets(3).Name = [F5]
      Case "$F$6": Sheets(4).Name = [F6]
      Case "$F$7": Sheets(5).Name = [F7]
      Case "$F$8": Sheets(6).Name = [F8]

     End Select
Call rename
    Application.EnableEvents = True
End Sub

Bonsoir XMen,

Merci à toi c'est pile ce que je voulais.

Cordialement