Extraire ligne suivant couleur de police

Sub Macro1()
Dim cel As Range 'déclare la variable cel (CELlule)
Dim dest As Range 'déclare la variable dest (DESTination)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim x As Integer 'déclare la variable x
 
With Sheets("Feuil1") 'prend en compte l'onglet "Feuil1"
    dl = .Range("A65536").End(xlUp).Row 'définit la variable dl
    For x = dl To 1 Step -1 'boucle inversée sur toutes les cellules éditées de la colonne A (de la dernière à la première)
        If .Cells(x, 1).Font.ColorIndex = 3 Then 'condition 1 : si la couleur d'encre de la cellule est rouge
            If Sheets("Feuil2").Range("A1").Value = "" Then 'condition 2 : si A1 de l'onglet "Feuil2" est vide
                Set dest = Sheets("Feuil2").Range("A1") 'définit la variable dest (A1)
            Else 'sinon
                Set dest = Sheets("Feuil2").Range("A65536").End(xlUp).Offset(1, 0) 'définit la variable dest (la première cellule vide)
            End If 'fin de la condition 2
            .Cells(x, 1).EntireRow.Cut dest 'coupe et colle la ligne
            .Cells(x, 1).Delete shift:=xlShiftUp 'supprime la ligne vide
        End If 'fin de la condition 1
    Next x 'prochaine cellule de la colonne A
End With 'fin de la prise en compte de l'onglet "Feuil1"
End Sub

Sub Depl_Lig()
'
'***************************************************************************************
'*
'* Macro de déplacement de lignes d'une feuille à une autre suivant critères
'*
'***************************************************************************************
'
Dim cel As Range 'déclare la variable cel (CELlule)
Dim dest As Range 'déclare la variable dest (DESTination)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim x As Integer 'déclare la variable x
 
Application.ScreenUpdating = False 'masque les changements à l'écran
With Sheets("A TRIER") 'prend en compte l'onglet "Feuil1"
    dl = .Range("A65536").End(xlUp).Row 'définit la variable dl
    'boucle inversée sur toutes les cellules éditées de la colonne A (de la dernière à la première)
    For Each cel In .Range("A2:A" & dl)
        'condition 1 : si la couleur d'encre de la cellule est rouge
        If cel.Font.ColorIndex = 3 Then
            Set dest = Sheets("Inactifs").Range("A65536").End(xlUp).Offset(1, 0)
            'coupe et colle la ligne
            cel.EntireRow.Cut dest
        End If
    Next cel
    'boucle inversée sur toutes les cellules éditées de la colonne A (de la dernière à la première)
    For x = dl To 1 Step -1
        'condition 1 : si cellule est vide
        If .Cells(x, 1).Value = "" Then
            .Rows(x).Delete shift:=xlShiftUp 'suprime la ligne
        End If
    Next x
End With
Application.ScreenUpdating = True 'affiche les changements à l'écran
End Sub