importer des données selon la couleur de la police

Bonjour à tous,

J'ai cherché sur le forum mais je n'ai pas trouvé de réponses à ma question.
Je souhaite importer des données d'un fichier excel vers un autre sous certaines conditions. Un de ces conditions est la couleur de la police (rouge) mais je ne c'est pas comment le faire à partir de mon code.

Cette information est contenue dans la colonne 24 (fichier Activities status)

Merci d'avance pour votre aide

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub reporter_std() 
Dim Sh As Worksheet 
 
Dim LastLig As Long, NewLig As Long 
Dim c As Range 
Dim Valeur As String 
 
 
Valeur = InputBox("Entrée période", "Choix de la période") 
If Valeur <> "" Then 
Application.ScreenUpdating = False 
With Workbooks("2010 STD Activities status.xls").Sheets("2010") 
   .AutoFilterMode = False 
   LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row 
   With .Range("A4:X" & LastLig) 
      .AutoFilter field:=17, Criteria1:=Valeur 
      .AutoFilter field:=24, Criteria1:=">0" 
      .AutoFilter field:=9, Criteria1:="STD" 
     End With 
   If .Range("A4:A" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then 
      Set Sh = Worksheets("std") 
      NewLig = Sh.Cells(Sh.Rows.Count, "A").End(xlUp).Row + 1 
      For Each c In .Range("A5:A" & LastLig).SpecialCells(xlCellTypeVisible) 
         Sh.Cells(NewLig, 1).Value = .Cells(c.Row, 7).Value 
         Sh.Cells(NewLig, 2).Value = .Cells(c.Row, 8).Value 
         Sh.Cells(NewLig, 5).Value = .Cells(c.Row, 10).Value 
         Sh.Cells(NewLig, 7).Value = .Cells(c.Row, 12).Value 
         Sh.Cells(NewLig, 16).Value = .Cells(c.Row, 17).Value 
         Sh.Cells(NewLig, 12).Value = .Cells(c.Row, 24).Value 
         Sh.Cells(NewLig, 8).Value = .Cells(c.Row, 9).Value 
         Sh.Cells(NewLig, 9).Value = .Cells(c.Row, 29).Value 
         Sh.Cells(NewLig, 3).Value = UCase(Sh.Cells(NewLig, 1).Value) & UCase(Sh.Cells(NewLig, 2).Value) 
         Sh.Cells(NewLig, 3).Value = Replace(Cells(NewLig, 3).Value, " ", "") 
         NewLig = NewLig + 1 
 
 
      Next c 
      Set Sh = Nothing 
      .AutoFilterMode = False 
   End If 
End With 
End If 
End Sub

Delphine