Sub RenommeFeuilles()
Dim w As Worksheet, txt As String, i As Long
Application.ScreenUpdating = False
'---renommage provisoire si formule de liaison en C3---
For Each w In Worksheets
txt = Mid(w.[C3].Formula, 2, 99)
On Error Resume Next
txt = Range(txt).Address
If Err = 0 Then
i = i + 1
w.Name = Chr(1) & i
End If
Next
'---renommage définitif avec indice si doublon---
For Each w In Worksheets
If w.Name Like Chr(1) & "*" Then
i = 0
txt = ""
1 On Error Resume Next
w.Name = Left(w.[C3], 31 - Len(txt)) & txt
If Err Then
i = i + 1
txt = "(" & i & ")"
GoTo 1
End If
End If
Next
End Sub