XL pour MAC Récupérer l'ensemble des lignes de couleur X dans un onglet

Sub Copie()
Application.ScreenUpdating = False

Dim WsDst As Worksheet, Ws As Worksheet, DerligDst&, Derlig&, i&

Set WsDst = Worksheets("Synthèse")
DerligDst = WsDst.Range("B" & Rows.Count).End(xlUp).Row + 1
WsDst.Range("B4:E" & DerligDst).ClearContents
DerligDst = WsDst.Range("B" & Rows.Count).End(xlUp).Row + 1

For Each Ws In Worksheets
    With Ws
        If .Name <> "Synthèse" Then
            Derlig = .Range("A" & Rows.Count).End(xlUp).Row
            For i = 4 To Derlig
                If .Range("A" & i).Font.ColorIndex = 3 Then
                    WsDst.Range("B" & DerligDst & ":E" & DerligDst) = .Range("A" & i & ":D" & i).Value
                    DerligDst = WsDst.Range("B" & Rows.Count).End(xlUp).Row + 1
                End If
            Next i
        End If
    End With
Next Ws
Set WsDst = Nothing
End Sub

Sub Copier_par_Filtre_Couleur()
Dim ws As Worksheet
For Each ws In Worksheets
    If ws.Name <> "Synthèse" Then
        ws.[A3].CurrentRegion.AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterFontColor
        With ws.AutoFilter.Range
        Set rngF = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible)
        End With
        rngF.Copy Sheets("Synthèse").Cells(Rows.Count, "B").End(3)(2)
        ws.AutoFilterMode = False
    End If
Next
End Sub

Sub Traitement()
'ici on peut choisir la couleur
'ici: rouge
Copie_Couleur vbRed
End Sub
Private Sub Copie_Couleur(couleur)
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Synthèse" Then
ws.[A3].CurrentRegion.AutoFilter 1, couleur, 9
Set rngF = ws.AutoFilter.Range.Offset(1, 0).Resize(ws.AutoFilter.Range.Rows.Count - 1, ws.AutoFilter.Range.Columns.Count).SpecialCells(12)
rngF.Copy Sheets("Synthèse").Cells(Rows.Count, "B").End(3)(2): ws.AutoFilterMode = 0
End If
Next
End Sub

Sub QueLesRouges()
Dim sh, n&, der&, i&, j&, f
  
   For Each sh In Worksheets     'calcul d'un majorant n du nombre de lignes du tableau résultat
      If sh.Name <> Sheets("Synthèse").Name Then n = n + sh.UsedRange.Rows.Count
   Next sh
   ReDim t(1 To n, 1 To 4): n = 0      'déclaration et dimmensionnement du tableau résultat
   For Each sh In Worksheets           'pour chaque feuille de calcul
      If sh.Name <> Sheets("Synthèse").Name Then   'seulement si on ne traite pas la feuille "Synthèse"
         With sh                                   'avec la feuille qu'on traite
            If .FilterMode Then .ShowAllData       'si filtre, on affiche tout - pour bon fonctionnement de End(xlup)
            der = .Cells(Rows.Count, "a").End(xlUp).Row  'dernière ligne de données de la la feuille sh
            If der >= 4 Then                             'si il y a au moins une ligne source
               f = .Range("a4:d" & der)                  'on lit le tableau source de sh
               For i = 1 To UBound(f)                    'boucle sur le tableau source
                  'si la police est rouge, on recopie la ligne source (depuis f) dans la ligne suivante du tableau résultat (t)
                  If .Cells(3 + i, "a").Font.Color = vbRed Then: n = n + 1: For j = 1 To 4: t(n, j) = f(i, j): Next
               Next i
            End If
         End With
      End If
   Next sh
   Application.ScreenUpdating = False                    'on fige l'affichage (plus rapide)
   With Sheets("Synthèse")                               'avec la feuille "Synthèse"
      .Activate                                          'on active la feuille
      If .AutoFilterMode Then Cells.AutoFilter           'si autofiltre, on l'enlève
      .Range("b5:e" & Rows.Count).Clear                  'on efface les résultats précédents (ligne 5 à la dernière ligne)
      .Range("b5").Resize(n, 4) = t                      'on transfère les n premières lignes résultats de t sur la feuille
      .Range("d5").Resize(n).NumberFormat = "# ##0.00"   'on formate la colonne des montants (deux décimales)
      .Range("b4").Resize(n + 1, 4).AutoFilter           'on "autofiltre" le résultat
   End With
End Sub