Renommé onglet exemple: 311209 en 091231

[COLOR="DarkSlateGray"][B]Sub renomme()
   toto True
End Sub

Sub annule()
   toto False
End Sub

Private Sub toto(o As Boolean)
Dim i As Long, j As Long, k As Long, oDat()
   Application.ScreenUpdating = False
   For i = 1 To Worksheets.Count
      If Worksheets(i).Name Like "######" Then
         j = j + 1
         ReDim Preserve oDat(1 To 3, 1 To j)
         oDat(2, j) = Worksheets(i).Name
         oDat(3, j) = Right$(oDat(2, j), 2) & Mid$(oDat(2, j), 3, 2) & Left$(oDat(2, j), 2)
         On Error GoTo E
         Worksheets(i).Name = "F" & j + k
         On Error GoTo 0
         oDat(1, j) = Worksheets(i).Name
      End If
   Next
   If j Then
      Worksheets.Add
      With Cells(1, 1).Resize(j, 3)
         .Value = WorksheetFunction.Transpose(oDat)
         .Sort Key1:=.Cells(1, 1).Offset(0, 1 - o), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
         oDat = WorksheetFunction.Transpose(.Cells.Value)
      End With
      Application.DisplayAlerts = False
      ActiveSheet.Delete
      Application.DisplayAlerts = True
      For i = j To 1 Step -1
         Worksheets(oDat(1, i)).Move before:=Sheets(1)
         Sheets(1).Name = Right$("0" & oDat(3, i), 6)
      Next
   End If
   Application.ScreenUpdating = True
Exit Sub
E: k = k + 1: Resume
End Sub[/B][/COLOR]