Copie Ligne suivant couleur texte

Sub btnOK()

  [COLOR=Blue]Dim I As Byte
  Dim Li As Long
  Dim Cel As Range
[/COLOR]
  Application.ScreenUpdating = False
  For I = 0 To LbFeuilles.ListCount - 1
    If LbFeuilles.Selected(I) = True Then
      Application.StatusBar = "Exportation: " & LbFeuilles.List(I)
      [COLOR=Blue]Li= 1 [COLOR=Olive]'à voir[/COLOR]
      With Sheets(LbFeuilles.List(I))
        For Each Cel In [B].[/B]Range("A1:A" & [B].[/B]Range("32000").End(xlUp).Row)
          If Not IsEmpty(Cel) Then
            If Cel.Font.ColorIndex = -4105 Then
              Li = Li + 1
              Cel.Copy Sheets("Data-Globale").Cells(Li, "B") [COLOR=Olive] [B]'Colonne B[/B][/COLOR]
            End If
          Next
        Next
      End With[/COLOR]
      'Sheets(LbFeuilles.List(i)).PrintPreview
    End If
  Next I
  Unload Me
  FrmInterface.Hide
  Application.StatusBar = False
  Application.ScreenUpdating = True
End Sub

If .Cells(I, 1).Font.ColorIndex = -4105[COLOR=red][B] [COLOR=red]Or [/COLOR][/B][/COLOR][COLOR=#000000][B][COLOR=red].Cells(I, 1).Font.ColorIndex = 1[/COLOR][/B] Then[/COLOR]