Onglet Changement de nom

[jorisphi]

Bonjour à tous,

J'aimerai avoir un macro qui me change le nom des onglets et ce, lorsque j'encode les nouveaux noms dans ma feuille nommée "Introduction" , soit dans les cellules C5 à C14
Je joins mon fichier d'exemple

Cordialement
Jorisphi

 

[tototiti2008]

Re : Onglet Changement de nom

Bonjour Jorisphi,

un essai à mettre dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cellule As Range
    If Not Application.Intersect(Target, Range("C5:C14")) Is Nothing Then
        For Each Cellule In Application.Intersect(Target, Range("C5:C14")).Cells
            On Error Resume Next
                ThisWorkbook.Worksheets(Cellule.Offset(0, -1).Value).Name = Cellule.Value
                Cellule.Offset(0, -1).Value = Cellule.Value
            On Error GoTo 0
        Next Cellule
    End If
End Sub

 

[ROGER2327]

Re : Onglet Changement de nom

Bonjour à tous

Une autre proposition dans le classeur joint.

[COLOR="DarkSlateGray"][B]Sub toto()
Dim oDat, i As Long

   With [B5]

      If Cells(Rows.Count, .Column).End(xlUp).Cells(1, 1).Row < .Row Then GoTo E

      With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With

      oDat = Range(.Cells, Cells(Rows.Count, .Column + 1).End(xlUp)).Value

      On Error Resume Next
      For i = 1 To UBound(oDat, 1)
         ThisWorkbook.Sheets(CStr(oDat(i, 1))).Name = CStr(oDat(i, 2))
      Next
      On Error GoTo 0

      With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With

E: End With

End Sub[/B][/COLOR]

ROGER2327
#2561

 

[jorisphi]

Re : Onglet Changement de nom

Bonjour tototiti2008
Je lis ce jour votre réponse à mon post
Grand merci pour votre réponse, Cela fonctionne à merveille
A Bientôt
Cordialement
Jorisphi

Bonjour Jorisphi,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cellule As Range
    If Not Application.Intersect(Target, Range("C5:C14")) Is Nothing Then
        For Each Cellule In Application.Intersect(Target, Range("C5:C14")).Cells
            On Error Resume Next
                ThisWorkbook.Worksheets(Cellule.Offset(0, -1).Value).Name = Cellule.Value
                Cellule.Offset(0, -1).Value = Cellule.Value
            On Error GoTo 0
        Next Cellule
    End If
End Sub

 

[jorisphi]

Re : Onglet Changement de nom

Bonjour Roger2327
Grand merci pour votre autre proposition très interessante
Un tout grand merci pour votre aide pécieuse
Cordialement
Jorisphi

Bonjour à tous

Une autre proposition dans le classeur joint.

[COLOR="DarkSlateGray"][B]Sub toto()
Dim oDat, i As Long

   With [B5]

      If Cells(Rows.Count, .Column).End(xlUp).Cells(1, 1).Row < .Row Then GoTo E

      With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With

      oDat = Range(.Cells, Cells(Rows.Count, .Column + 1).End(xlUp)).Value

      On Error Resume Next
      For i = 1 To UBound(oDat, 1)
         ThisWorkbook.Sheets(CStr(oDat(i, 1))).Name = CStr(oDat(i, 2))
      Next
      On Error GoTo 0

      With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With

E: End With

End Sub[/B][/COLOR]

ROGER2327
#2561