vba:Automatiser la copie des données de 45 feuilles dans une seule

Sub Recap()
Dim og As Worksheet 'déclare la variable og (OnGlet)
Dim pe As Range 'décalre la variable pe (Plage à Effacer)
 
Application.ScreenUpdating = False 'masque les changements à l'écran
 
'*********************************
'suppression des anciennes données
'*********************************
If Sheets("Recap").Range("A2").Value <> "" Then 'condition si la cellule A2 de l'onglet "Recap" n'est pas vide
    Set pe = Sheets("Recap").Range("A2").CurrentRegion 'définit la plage pe
    pe.Clear 'efface la plage pe
End If 'fin de la condition
 
'****************************************************
'récupération des données dans les différents onglets
'****************************************************
For Each og In Sheets 'boucle sur tous les onglets du classeur
    Select Case Left(og.Name, 4) 'action en fonction des 4 premières lettres du nom de l'onglet
        Case "DATA" 'cas "DATA"
            Set dest = Sheets("Recap").Range("A65536").End(xlUp).Offset(1, 0) 'définit la cellue de destination
            og.Range("A1:AZ1000").Copy dest 'copie et colle ;a plage
    End Select 'fin de l'action en fonction de...
Next og 'prochain onglet de la boucle
Application.ScreenUpdating = True 'affiche les changements à l'écran
End Sub

Sub RecopieParArray()
Dim s As Worksheet, p As Range
Application.ScreenUpdating = False
    For Each s In Worksheets
        If Val(Right(s.Name, 3)) <= 10 Then
        Set p = s.Range(s.[A1], s.[AZ1000])
        Sheets("SYNTHESE").[A65536].End(xlUp).Offset(1).Resize(p.Rows.Count, _
        p.Columns.Count).Value = p.Value
        End If
    Set p = Nothing
    Next s
Application.ScreenUpdating = True
End Sub

Sub Recap()
Dim og As Worksheet 'déclare la variable og (OnGlet)
Dim pe As Range 'décalre la variable pe (Plage à Effacer)
 
Application.ScreenUpdating = False 'masque les changements à l'écran
 
'*********************************
'suppression des anciennes données
'*********************************
If Sheets("Recap").Range("A2").Value <> "" Then 'condition si la cellule A2 de l'onglet "Recap" n'est pas vide
    Set pe = Sheets("Recap").Range("A2").CurrentRegion 'définit la plage pe
    pe.Clear 'efface la plage pe
End If 'fin de la condition
 
'****************************************************
'récupération des données dans les différents onglets
'****************************************************
For Each og In Sheets 'boucle sur tous les onglets du classeur
    Select Case Left(og.Name, 4) 'action en fonction des 4 premières lettres du nom de l'onglet
        Case "DATA" 'cas "DATA"
            Set dest = Sheets("Recap").Range("A65536").End(xlUp).Offset(1, 0) 'définit la cellue de destination
            Range(dest, dest.Offset(999, 0)).Value = og.Name 'place le nom de l'onglet dans la colonne A
            og.Range("A1:AZ1000").Copy dest.Offset(0, 1) 'copie et colle la plage à partir de la colonne B
    End Select 'fin de l'action en fonction de...
Next og 'prochain onglet de la boucle
Application.ScreenUpdating = True 'affiche les changements à l'écran
End Sub

Sub RecopieParArray()
Dim og As Worksheet, pl As Range
 
Application.ScreenUpdating = False
 
'*********************************
'suppression des anciennes données
'*********************************
If Sheets("Recap").Range("A2").Value <> "" Then 'condition si la cellule A2 de l'onglet "Recap" n'est pas vide
    Sheets("Recap").Range("A2").CurrentRegion.Clear 'efface les anciennes données
End If 'fin de la condition
 
'****************************************************
'récupération des données dans les différents onglets
'****************************************************
For Each og In Worksheets
    If Left(og.Name, 4) = "DATA" Then
        Set pl = og.Range(og.[A1], og.[AZ1000])
        Sheets("Recap").[A65536].End(xlUp).Offset(1).Resize(pl.Rows.Count, 1).Value = og.Name
        Sheets("Recap").[B65536].End(xlUp).Offset(1).Resize(pl.Rows.Count, _
            pl.Columns.Count).Value = pl.Value
    End If
    Set pl = Nothing
Next og
Application.ScreenUpdating = True
End Sub