Copier des éléments de plusieurs feuille pour en faire une synthese

Option Explicit
Sub Synthèse_autre_cas()
    Dim o As Object, sy As Object
    Dim Cel As Range
    Set sy = Sheets("synthese")
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    sy.Activate
    Range("a4:j65000").Clear
    For Each o In Worksheets
        If o.Name <> "synthese" And o.Range("A5") Like "Nom*" Then
            o.Range("b4").Copy sy.Range("a" & Rows.Count).End(xlUp)(2)
            o.Range("b5").Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 1)
            o.Range("f4").Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 2)
            For Each Cel In o.Range("A1:A50")
                If Cel.Value = "Objectif" Then
                    Cel.Offset(, 2).Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 3)   'C22
                    Cel.Offset(-1, 3).Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 4)   'D21
                    Cel.Offset(, 3).Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 5)   'D22 Erreur chez toi
                    Cel.Offset(-1, 4).Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 6)   'E21
                    Cel.Offset(, 4).Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 7)   'E22
                    Cel.Offset(-1, 5).Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 8)   'F21
                    Cel.Offset(, 5).Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 9)   'F22

                   

                   
                End If
            Next Cel
                       
           ' o.Range("c22").Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 3)
           ' o.Range("d21").Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 4)
          '  o.Range("c22").Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 5)
           ' o.Range("e21").Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 6)
            'o.Range("e22").Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 7)
          '  o.Range("f21").Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 8)
           ' o.Range("e12").Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 9)

        End If
    Next
    Range("a4").CurrentRegion.Borders.Value = 1
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub

Option Explicit
Sub Synthèse_autre_cas()
    Dim o As Object, sy As Object
    Dim Cel As Range
    Set sy = Sheets("synthese")
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    sy.Activate
    Range("a4:j65000").Clear
    For Each o In Worksheets
        If o.Name <> "synthese" And o.Range("A5") Like "Nom*" Then
            o.Range("b4").Copy sy.Range("a" & Rows.Count).End(xlUp)(2)
            o.Range("b5").Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 1)
            o.Range("f4").Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 2)
            For Each Cel In o.Range("A1:A50")
                If Cel.Value = "Objectif" Then
                    Cel.Offset(, 2).Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 3)   'C22
                    Cel.Offset(-1, 3).Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 4)   'D21
                    Cel.Offset(, 3).Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 5)   'D22 Erreur chez toi
                    Cel.Offset(-1, 4).Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 6)   'E21
                    Cel.Offset(, 4).Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 7)   'E22
                    Cel.Offset(-1, 5).Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 8)   'F21
                   
                End If
            Next Cel
            For Each Cel In o.Range("B1:B50")
                If Cel.Value = "Base variable" Then
                    Cel.Offset(, 1).Copy sy.Range("a" & Rows.Count).End(xlUp).Offset(, 9)   'E12
                    'Attention cellule fusionnée
                End If
            Next Cel
    
        End If
    Next
    Range("a4").CurrentRegion.Borders.Value = 1
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub