Bonjour
Code dans un Module
Sub Resultats()
'On bloque le rafraichissement de l'écran
Application.ScreenUpdating = False
'On établit la liste des Feuilles en colonne P
Range("P1").Value = "Liste des Feuilles"
For i = 2 To Worksheets.Count
[P1].Offset(i - 1, 0).Value = Worksheets(i).Name
Next i
'On numérote en colonne P les Feuilles de 1 à x
Range("Q1").Value = "Renommer"
Range("Q2:Q" & [P65000].End(xlUp).Row).Select
Selection.FormulaR1C1 = "=ROW()-1"
'On renomme les Feuilles, à partir de la Feuille2, 1, 2, 3 jusqu'à X
For i = 2 To Worksheets.Count
Worksheets(i).Name = [Q1].Offset(i - 1, 0).Value
Next i
'On fige les résultats de la Feuille "RECAP" en colonne D pour conserver les formules en colonne C
'On copie le résultat des formules
Range("a5", Range("a5").End(xlDown)).Offset(0, 2).Select
Selection.Copy
'On colle le résultat en colonne D
Selection.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'On renomme les Feuilles avec leur nom d'origine (Liste en colonne P)
For i = 2 To Worksheets.Count
Worksheets(i).Name = [P1].Offset(i - 1, 0).Value
Next i
Application.CutCopyMode = False
Range("D5").Select
'On efface les listes en colonnes P et Q
Range("P1:Q55").Clear
End Sub
et, si on veut effacer les résultats pour un nouveau test
Sub Efface_Result()
Range("a5", Range("a5").End(xlDown)).Offset(0, 3).Select
Selection.Clear
Range("g2").Select
End Sub
Bien sur, ici nous avons 4 feuilles et comme déjà signalé, il faudra pour plus de Feuilles adapter la formule en remplaçant les 3 occurences de COLONNE(A:D) par Ex: COLONNE(A:AX) pour 50 Feuilles
Cordialement