bonsoir a tous
et en particullier a Charly
bon j'ai encore besoin de vous
j'ai recopie un macro la dessous, je souhaiterais la modifier pour qu'en fait si excel detecte en colonne A&B sur 2 ou plusieurs lignes les memes elements alors qu'il me recopie les lignes en doublon à la fin de la 1ere
c'est a dire........
si j'ai une ligne comme ca
AAA BBB CCC DDD EEE FFF
et une autre
AAA BBB GGG HHH III JJJ
et une autre (c un exemple)
AAA BBB XXX YYY ZZZ WWW
alors que les lignes 2 et 3 soient recopiees derriere la 1ere soit
AAA BBB CCC DDD EEE FFF AAA BBB GGG HHH III JJJ AAA BBB XXX YYY ZZZ WWW
voila si vous me trouvez comment modifier tout cela je vous embrasse (bon faut pas exagerer) mais quand meme cela m'enlevera une grosse epine du pied
merci
Option Explicit
Sub Regroupement()
'
Dim Ligne&
Dim Col%, ColFin%, ColAjout%
Dim Plage As Range
'
Application.ScreenUpdating = False
Ligne = 2 ' on commence à la ligne 2
'
' et on boucle tant que la cellule A(Ligne) n'est pas vide
Do Until IsEmpty(Cells(Ligne, 1))
'
' ColAjout contiendra la première colonne libre de la
' ligne précédent 'Ligne'
ColAjout = Cells(Ligne - 1, 256).End(xlToLeft).Column + 1
'
' Plage représentera les cellules de la ligne précédente
' de la colonne B à la dernière colonne contenant des données
Set Plage = Range(Cells(Ligne - 1, 2), Cells(Ligne - 1, ColAjout - 1))
'
' ColFin contient la dernière colonne de données sur la ligne
' actuelle
ColFin = Cells(Ligne, 256).End(xlToLeft).Column
'
' si le contenu de la colonne A de la ligne actuelle est égale
' à celui de la colonne A ligne précédente,
If Cells(Ligne, 1) = Cells(Ligne - 1, 1) Then
'
' alors on transfère les données de la ligne courante qui
' ne sont pas déjà dans la ligne précédente...
For Col = 2 To ColFin
If Plage.Find(what:=Cells(Ligne, Col), LookIn:=xlValues, _
lookat:=xlWhole) Is Nothing Then
Cells(Ligne - 1, ColAjout) = Cells(Ligne, Col)
ColAjout = ColAjout + 1
End If
Next
'
' et on supprime la ligne copiée
Cells(Ligne, 1).EntireRow.Delete
Else
' s'il n'y a pas d'égalité de contenu, alors on incrémente Ligne
Ligne = Ligne + 1
End If
Loop
Application.ScreenUpdating = True
End Sub
