Isoler des cellules

Bonjour
Jai une macro qui a partir de l'année d'une date saisi me colorie en rouge toutes les cellules dans lesquelles cette année apparait
je souhaiterais isoler dans une autre feuille toutes les cellules en rouge
merci :)

voici le code de ma macro et le fichier correspondant

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14

Sub date_2() Dim X As Variant Dim Cel As Range X = Application.InputBox("Année de la date", "ANNÉE", Type:=1) If X = False Then Exit Sub Set Cel = Sheets("Feuil1").UsedRange.Find(X, lookat:=xlPart) If Not Cel Is Nothing Then PA = Cel.Address Do Cel.Interior.ColorIndex = 3 Set Cel = Sheets("Feuil1").UsedRange.FindNext(Cel) Loop While Not Cel Is Nothing And Cel.Address <> PA End If End Sub

---

Bonjour
Hé bien -->> n'attends pas de colorer puis d'agir sur la base de la coloration !
Fais-le dans la foulée, avant même de colorer !

Bonjour,

Je te recommande l'utilisation des filtres avancés:http://philippetulliez.developpez.co...dvancedfilter/

Attention, utiliser la couleur n'est pas une bonne idée, autant utiliser directement le critère qui t'a permis de colorer les cellules.

Bonjour Unparia, Halaster08,
je vous remercie pour vos réponses :)
Unparia ==> j'ai essayer d'anticiper et ne pas attendre que sa colore mais étant encore débutante je n'ai pas réussi

Halaster ==> je ne peux pas utiliser de filtre (consigne) cependant je retiens qu'il ne faut pas que j'utilise la couleur pour mon critère

Bonjour
Peut être avec ça :
Juste n'oublier pas à nettoyer la feuille 2 avant de copier

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

Sub filtre2() Dim j As Integer   Dim X As Variant Dim Cel As Range X = Application.InputBox("Année de la date", "ANNÉE", Type:=1) If X = False Then Exit Sub Set Cel = Sheets("Feuil1").UsedRange.Find(X, lookat:=xlPart) If Not Cel Is Nothing Then PA = Cel.Address j = 1 Do Cel.Interior.ColorIndex = 3 Sheets("Feuil2").Range("A" & j).Value = Cel.Value j = j + 1 Set Cel = Sheets("Feuil1").UsedRange.FindNext(Cel) Loop While Not Cel Is Nothing And Cel.Address <> PA End If   End Sub

---

Merciii Bennasr c'est exactement ce que je voulais :D

:D :D MERCI A VOUS TOUS LES AMIS !!