Discussion :

[eliana55]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[unparia]

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 !

[halaster08]

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.

[eliana55]

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

[BENNASR]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[eliana55]

Merciii Bennasr c'est exactement ce que je voulais

MERCI A VOUS TOUS LES AMIS !!