Une feuille de résultats pour un nombre de feuille aléatoir

Sub extraire()
Application.ScreenUpdating = False
For Each sh In Sheets
    If sh.Name <> "Résultat" Then
        x = Right(sh.Name, Len(sh.Name) - 8)
        Cells(x + 1, 1) = sh.Name: Cells(x + 1, 2) = sh.[D5]
    End If
Next sh

End Sub
Sub creer()
Application.ScreenUpdating = False
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Pièce n°" & Sheets.Count
Sheets("Résultat").Select
End Sub

Sub extraire()
Application.ScreenUpdating = False  'Fige le raffraichissement de l'écran
For Each sh In Sheets   'pour chaque onglet dans le classeur(on scanne toutes les feuilles)
    If sh.Name <> "Résultat" Then   'Si le nom de l'onglet est différent de :...
        x = Right(sh.Name, Len(sh.Name) - 8)  'on cherche son numéro, c'est à dire qu'on
                                                'extrait le ou les dernières lettres à droite
                                                ' du nom de l'onglet en fonction du nombre
                                                ' de lettres dans ce nom
        Cells(x + 1, 1) = sh.Name: Cells(x + 1, 2) = sh.[D5] 'la cellule de la ligne (x+1) donc
                                                ' si l'onglet est le 5, ligne 6, et de la colonne
                                                ' 1 récupère le nom de l'onglet
                                                ' la cellule d'à côté récupère la valeur de D5 de l'onglet
    End If
Next sh

End Sub
Sub creer()
Application.ScreenUpdating = False
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Pièce n°" & Sheets.Count
        ' on insère un nouvel onglet, après le dernier onglet, et avec comme nom "Pièce n°" et
        ' nombre d'onglets
Sheets("Résultat").Select
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
teste si target est bien en A1 pour que la procédure ne s'active pas inutilement
    ActiveSheet.Name = Range("A1").Value
ensuite envoie également le nom dans ta première feuille
End Sub

Sub extraire()
Application.ScreenUpdating = False
derlig = IIf([A65000].End(xlUp).Row = 1, 2, [A65000].End(xlUp).Row + 1)
Range("A2:B" & derlig).ClearContents
For Each sh In Sheets
    If sh.Name <> "Résultat" Then
        derlig = IIf([A65000].End(xlUp).Row = 1, 2, [A65000].End(xlUp).Row + 1)
        With Range("A" & derlig)
            .Value = sh.Name
            .Offset(0, 1).Value = sh.[D5]
        End With
    End If
Next sh
End Sub

Application.ScreenUpdating = True
End Sub

Sub extraire()
Application.ScreenUpdating = False
derlig = IIf([A65000].End(xlUp).Row = 1, 2, [A65000].End(xlUp).Row + 1)
Range("A2:G" & derlig).ClearContents
For Each sh In Sheets
    If sh.Name <> "Résultat" Then
        derlig = IIf([A65000].End(xlUp).Row = 1, 2, [A65000].End(xlUp).Row + 1)
        With Range("A" & derlig)
            .Value = sh.Name
            .Offset(0, 1).Value = sh.[D5]
            .Offset(0, 2).Value = sh.[E6]
            .Offset(0, 3).Value = sh.[F9]
            .Offset(0, 4).Value = sh.[J11]
            .Offset(0, 5).Value = sh.[H4]
            .Offset(0, 6).Value = sh.[M2]
        End With
    End If
Next sh
End Sub