Synthétiser plusieurs feuilles excel

Sub recap()
Dim ws As Worksheet

LigneInit = 8
For Each ws In Sheets
    If ws.Name Like "Projet *" Then
        With ws
            Taille = .Range("A4").CurrentRegion.Rows.Count '.Copy
            .Range("A4").CurrentRegion.Offset(1, 0).Resize(Taille - 1).Copy Destination:=Sheets("RECAP").Range("B" & LigneInit)
            With Sheets("RECAP")
                .Range("A" & LigneInit) = ws.Name
                .Range("A" & LigneInit).Resize(Taille - 1).Merge
            End With
            LigneInit = LigneInit + Taille - 1

        End With
    End If
Next ws
End Sub

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim R As Worksheet 'déclare la variable R (onglet Recap)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTInation)

Set R = Worksheets("RECAP") 'définit l'onglet R
R.Range("A7").CurrentRegion.Offset(1, 0).Rows.Delete 'efface d'éventuelle anciennes données de l'onglet R
For Each O In Worksheets 'boucle sur tous les onglets O du classeur
    If Not O.Name = "RECAP" And Not O.Name = "Données" Then 'condition : si l'onglet ne se nomme ni RECAP ni Données
        Set DEST = R.Cells(Application.Rows.Count, "C").End(xlUp).Offset(1, -2) 'définit la cellule de destination DEST
        DL = O.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet O
        O.Range("A4:I" & DL).Copy DEST.Offset(0, 1) 'copie la plage A4:I... et la collle dans DEST
        DEST.Resize(DL - 3, 1).Merge 'fusion des cellules
        DEST.Value = O.Name 'envoie le nom de l'onglet O dans DEST
        DEST.VerticalAlignment = xlTop 'alignement vertical de DEST en haut
    End If 'fin de la condition
Next O 'prochain onglet de la boucle
End Sub