trouver et copier

Bonjour,
Je propose ceci
'--------------------
Sub jj()
x = 2
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
For j = Range("A" & Rows.Count).End(xlUp).Row To i + 1 Step -1
If Cells(i, 1) = Cells(j, 1) Then
Cells(i, x) = Cells(j, 1)
Rows(j).Delete
x = x + 1
End If
Next
x = 2
Next
End Sub
'------------------
Exemple ici:
http://www.cijoint.fr/cjlink.php?file=cj200902/cijYsEreKr.xls

--
Salutations
JJ


"guy.veuillet" <guy.veuillet@orange.fr> a écrit dans le message de news:
498aa02e$0$18353$ba4acef3@news.orange.fr...

Bonjour
J'arrive en vba à trouver les cellules identiques dans une colonne
mais je souhaiterais les copier dans les colonnes suivantes exemple :
colonne A
1
1
2
3
1
5
2
1
6
2
etc....
il faudrait copier les 1 suivant en colonne B,C etc...
et idem pour les autres nombres (les 2 aligner sur colonne b,c, d etc...

merci
Guy

Salut Guy

Je ne sait pas si j'ai tout bien compris

Mais je tente cette proposition
Feuil1 colonne A les chiffres
Colonne B/C/D etc.... le résultat
Le code :

i = 2
Do While i < Sheets("Feuil1").Range("A65535").End(xlUp).Offset(1, 0).Row
On Error Resume Next
Ligne = Sheets("Feuil1").Range("B1", "B" &
Sheets("Feuil1").Range("B65535").End(xlUp).Row).Find(What:=Sheets("Feuil1").Range("A"
& i), After:=Sheets("Feuil1").Range("B1"), LookIn:=xlValues, LookAt:= _
xlWhole).Row
If Ligne > 1 Then
Sheets("Feuil1").Range("A" & Ligne).End(xlToRight).Offset(0, 1) =
Sheets("Feuil1").Range("A" & i)
Else
Sheets("Feuil1").Range("B65535").End(xlUp).Offset(1, 0) =
Sheets("Feuil1").Range("A" & i)
End If
Ligne = 0
i = i + 1
Loop

Fais des essais et dis moi !!!!!