Recherche de valeurs de cellules de couleur rouge

Bonjour Serge,

Essaie quelque chose comme ceci en adaptant les noms des objets, index couleur et feuille de destination selon ton application.

'--------------------------------------
Sub RechercherEtAfficher()

Dim Rg As Range, C As Range, Plg As Range
Dim Adr As String, A As Long, Nb As Long
Dim R As String, Sh As Worksheet

'La source de tes données
Set Sh = Worksheets("Feuil1") ' Nom Feuille à déterminer

With Sh
Set Rg = .Range("C:C,F:F,I:I")
End With

For Each C In Rg.Columns
Set Plg = C.SpecialCells(xlCellTypeConstants)
Nb = Plg.Cells.Count
Adr = Plg.Address
For A = Nb To 1 Step -1
R = Split(Adr, ",")(A - 1)
'à toi d'évaluer le colorindex de ta couleur
If Sh.Range(R).Interior.ColorIndex = 3 Then
Sh.Range(R).Copy _
Worksheets("Feuil2").Range("A65536").End(xlUp)(2)
'déterminer la feuille de destination ...
End If
Next
Next
Set Sh = Nothing: Set Plg = Nothing: Set Rg = Nothing

End Sub
'--------------------------------------


Salutations!



"Serge" <serge.g8[NOSPAM]@laposte.net> a écrit dans le message de news: dgoe4e$1o7n$1@biggoron.nerim.net...
Bonjour,


Je recherche dans ma feuille Feuil1 les valeurs de toutes mes cellules dont
la couleur du texte est rouge (ces valeurs peuvent être dans 3 colonnes).
Ces valeurs que je recherche, doivent se coller sur 1 seule colonne dans
une Feuil2.
Mes problèmes :
- Parcourir ma Feuil1 sur les colonnes 3,6 et 9 en partant de la
dernière cellule du bas (que je ne connais pas) en remontant.
- Et coller chaque valeur trouvée sur la dernière position de la colonne
1 de Feuil2.


Merci beaucoup.
serge

Bjour
Le code ci dessous devrait convenir :
Sub CopieRouge()
Dim d As Range
Sheets(1).Activate

Set d = Sheets(2).Range("A1")
Set Maplage = Union(Range("C1", Range("C1").End(xlDown).Offset(0,
-1).Address), Range("F1", Range("F1").End(xlDown).Offset(0,
-1).Address), Range("I1", Range("I1").End(xlDown).Offset(0,
-1).Address))
For Each C In Maplage
If C.Font.ColorIndex = 3 Then
d = C
Set d = d.Offset(1, 0)
End If
Next
End Sub





Philippe NOSS
http://nossphil.perso.cegetel.net/exoutils.html

Un détail important : La fonction Split est disponible à partir de la version Excel 2000. Si ta version est plus ancienne, cette
macro ne fonctionnera pas.


Salutations!

Bonjour Serge,

Cette procédure corrige une coquille de la sub soumise plutôt :

Sub RechercherEtAfficher()

Dim rg As Range, C As Range, Plg As Range
Dim Adr As String, A As Long, Nb As Long
Dim R As String, Sh As Worksheet
Dim Y As Long, G As Long

'La source de tes données
Set Sh = Worksheets("Feuil2") ' Nom Feuille à déterminer

With Sh
Set rg = .Range("C:C,F:F,I:I")
End With

For Each C In rg.Columns
Set Plg = C.SpecialCells(xlCellTypeConstants)
Nb = Plg.Cells.Areas.Count
Adr = Plg.Address
For A = Nb To 1 Step -1
R = Split(Adr, ",")(A - 1)
Y = Sh.Range(R).Rows.Count
For G = Y To 1 Step -1
ll = Sh.Range(R)(G).Address
If Sh.Range(R)(G).Font.ColorIndex = 3 Then
Sh.Range(R)(G).Copy _
Worksheets("Feuil2").Range("A65536").End(xlUp)(2)
End If
Next
Next
Next
Set Sh = Nothing: Set Plg = Nothing: Set rg = Nothing

End Sub
.-----------------------------------



Salutations!



"Serge" <serge.g8[NOSPAM]@laposte.net> a écrit dans le message de news: dgoe4e$1o7n$1@biggoron.nerim.net...
Bonjour,


Je recherche dans ma feuille Feuil1 les valeurs de toutes mes cellules dont
la couleur du texte est rouge (ces valeurs peuvent être dans 3 colonnes).
Ces valeurs que je recherche, doivent se coller sur 1 seule colonne dans
une Feuil2.
Mes problèmes :
- Parcourir ma Feuil1 sur les colonnes 3,6 et 9 en partant de la
dernière cellule du bas (que je ne connais pas) en remontant.
- Et coller chaque valeur trouvée sur la dernière position de la colonne
1 de Feuil2.


Merci beaucoup.
serge