Boucler sur plusieurs cellule - colorer la colonne

Bonjour ,

je viens vers vous aujourd'hui pour me passer une petite solution sur les boucle .

le code :

Private Sub Worksheet_Activate()
If ActiveSheet.Range("D1") < Date And ActiveSheet.Range("D1") <> "" Then
Range("D3:D13,D15:D25,D27:D39").Interior.ColorIndex = 15
End If
End Sub

Ce code est prévu pour une cellule , mais j'aimerai la boucler pour " D1 " jusqu'à " AH4" et pour chaque TRUE de la condition , que ça colore la colonne qui correspond à la cellule sous condition .

Merci par avance pour votre aide .

Bonjour,

à tester,

Private Sub Worksheet_Activate()
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
  If Cells(1, i) < Date And Cells(1, i) <> "" Then
    Union(Range(Cells(3, i), Cells(13, i)), Range(Cells(15, i), Cells(25, i)), Range(Cells(27, i), Cells(39, i))).Interior.ColorIndex = 15
  End If
Next i
End Sub

merci pour ta reponse je vais tester et je te redis ca !

Alors ca fonctionne nickel , merci pour le code !

Cependant , pour le finaliser , j'aimerai ne pas le colorer si la case est blanche ( <> 2 )

If Range(Cells(3, i), Cells(39, i)).Interior.ColorIndex <> 2 Then

le prob c'est que la , il ne colore pas toute la colonne , (surment a cause de "union" ) donc il faut le boucler sur chaque range de chaque colonne .

et la je suis bloqué ... ^^

je veux bien un petit coup de pousse , mici

pouvez-vous joindre votre fichier ?

voila le fichier .

Bonjour,

dans votre fichier tous les dates des cellules D1:AH1 sont plus grande que la date d'aujourd'hui

c'est normal qu'il ne se passe rien puisque la condition est :

If Cells(1, i) < Date And Cells(1, i) <> "" Then

oui je le sais , j'aijuste supprimer les données confidentiel mais je le tester sur une autre feuille .

Private Sub Worksheet_Activate()
Dim i As Long
Dim C As Range

For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Columns
  If Cells(1, i) < Date And Cells(1, i) <> "" Then
For Each C In Range("D3:AH39")
  If C(1, i).Interior.ColorIndex = 2 Then

C(1, i).Interior.ColorIndex = 15

End If
Next C
End If
Next i

End Sub

J'ai bosser dessus un peu , mais la il ne prend plus en compte ma condition de date ou il y a des soucis .

Bonjour,

à tester,

Private Sub Worksheet_Activate()
test
End Sub

Sub test()
For i = 4 To Cells(1, Columns.Count).End(xlToLeft).Column
 x = Cells(3, i).Interior.ColorIndex  'pour vérifier au pas à pas
'j'aimerai ne pas le colorer si la case est blanche ( <> 2 )
  If Cells(1, i) < Date And Cells(1, i) <> "" And Cells(3, i).Interior.ColorIndex <> 2 Then
    Union(Range(Cells(3, i), Cells(13, i)), Range(Cells(15, i), Cells(25, i)), Range(Cells(27, i), Cells(39, i))).Interior.ColorIndex = 15
  End If
Next i
End Sub

alors ton code fonctionne seulement je ne veux pas que ca colore toute la colonne .

et c'est pareil , tu creer X ,seulement il est implanter nul part dans la verif des cellules .

je comprend pas trop ton code la .

Bonjour,

tu creer X ,seulement il est implanter nul part dans la verif des cellules .

j'ai ajouteé cette variable uniquement pour vérifier la couleur de la cellule lorsque j'ai executé la macro en mode pas à pas.

alors ton code fonctionne seulement je ne veux pas que ca colore toute la colonne .

je ne sais pas jusqu'à quel ligne les cellules doivent être coloré ?

En gros en F1 = une date . si elle est inférieur a la date du jour (date)

alors les cellules de la colonne doivent se colorer en gris , MAIS seulement si elle sont blanche ou sans couleur .

Pour le code , soit sa prend en compte la date et elle va colorer toute la colonne donc c'est pas bon ,

soit sa va colorer les case blanche mais mm si la date et sup à aujourdhui , dc pas bon nn plus .

Donc il faut boucler sur les C de D1 à AH1 et pour ceux qui sont inf à date , boucler sur les cellules de leur colonne et de les colorer si <> blanc .

Bonjour,

à tester,

For col = 4 To Cells(1, Columns.Count).End(xlToLeft).Column 'boucle sur les colonnes (ligne 1)
  For lign = 3 To 48 'boucle sur les lignes de la colonne (col)
    If Cells(1, col) < Date And Cells(lign, col).Interior.ColorIndex = 2 Then  '2 = blanc
      Cells(lign, col).Interior.ColorIndex = 15
    End If
  Next lign
Next col

eh ben écoute , cela marche nickel . je te remercie en tout cas pour ton aide et ta patience .

Au plaisir