Macro pour déplacer cellule avec condition

Bonjour, qqun serait-il creer une macro pour déplacer des cellules en fonction de condition citée dans l'exemple joint.

Merci à vous.

Phil

Bonjour,

Une solution à tester :

Sub Galopin()
Application.ScreenUpdating = false
i = Cells(Rows.Count, 5).End(xlUp).Row
For k = i To 4 Step -1
If Cells(k, 4).Interior.ColorIndex <> Cells(k, 5).Interior.ColorIndex Then
Cells(k, 5).Copy Cells(k - 1, 6)
Rows(k).Delete
End If
Next
End Sub

A+

Bonjour Galopin et merci pour ta rapidité.

La macro fonctionne mais j'ai remarqué que tu faisais le test en comparant les couleurs intérieures des cellules.

En fait j'ai mis ces couleurs pour me faire comprendre .

La condition est :

"Lorsque le code adjacent est autre que "LIB" cette regle ne doit pas s'appliquer, par ex: la case F4 ne doit pas aller en J3

, le déplacement de la cellule se fait si et seulement si le code adjacent est "LIB" (sauf sur la 1ere ligne)"

J'espere que je me suis assez explicite ...

Merci d'avance

Phil

Bonjour,

Sub Galopin()
Application.ScreenUpdating = False
i = Cells(Rows.Count, 5).End(xlUp).Row
For k = i To 4 Step -1
If Cells(k, 4) = "LIB" And Cells(k, 5).Interior.ColorIndex = 6 Then
Cells(k, 5).Copy Cells(k - 1, 6)
Rows(k).Delete
End If
Next
End Sub

Ce code est susceptible de fonctionner de manière aléatoire car pour Excel il y a beaucoup de nuances de jaune et il n'est pas certain que mon ColorIndex = 6 soit exact sur toutes les cellules même si en apparence la cellule est jaune... ça dépend un peu de la manière dont les cellules ont été colorées et de tes palettes de couleurs.

Donc on croise les doigts !

Ne fonctionne pas non plus si la coloration est le résultat d'une MFC. Dans ce cas il faudrait formuler encore autrement.

A+

Merci encore pour ta réponse,

en fait je voulais dire que j'avais mis les couleurs pour expliquer mon post.... mon fichier original n'a pas du tout de couleur .

Si tu comprends.

Merci d'avance

Phil

Re,

Pour le coup alors je ne comprend plus rien du tout.

Toutes les cellules ayant des LIB à gauche comment puis-je savoir si la cellule doit être remontée si je ne tiens pas compte des couleurs ?

A+

Alors,

quand il y a un code autre que "LIB" cela veut dire que c'est un article, dans mon cas l'article est "ALUELODIE".

Cela veut dire que tous les "LIB" qu'il y a en dessous de cet article correspond à la désignation de cet article.

C'est pour cela que je veux , à suivre d'un article , que les désignations se suivent....

(je joins un nouveau fichier avec plus d'explications)

Excuses si je ne suis pas assez clair.

Phil

J'ai réussi à obtenir ce que je voulais avec ce code.... si tu as des conseils en VBA pour aller plus vite , je suis preneur.

Bonne journée et encore merci.

Sub ALUELODIE()
Application.ScreenUpdating = False
i = Cells(Rows.Count, 4).End(xlUp).Row
For k = i To 4 Step -1
If Cells(k, 4) <> "LIB" And Cells(k, 6) = "" Then
Cells(k + 1, 5).Copy Cells(k, 6)
Rows(k + 1).Delete
End If
Next

i = Cells(Rows.Count, 4).End(xlUp).Row
For k = 4 To i Step 1
If Cells(k, 4) <> "LIB" And Cells(k + 1, 6) = "" Then
Cells(k + 2, 5).Copy Cells(k + 1, 6)
Rows(k + 2).Delete
End If
Next

i = Cells(Rows.Count, 4).End(xlUp).Row
For k = 4 To i Step 1
If Cells(k, 4) = "LIB" And Cells(k + 1, 4) = "LIB" And Cells(k, 6) = "" Then
Cells(k + 1, 5).Copy Cells(k, 6)
End If
Next

i = Cells(Rows.Count, 4).End(xlUp).Row
For k = 4 To i Step 1
If Cells(k, 6).Value = Cells(k + 1, 5).Value Then
Rows(k + 1).Delete
End If
Next
End Sub