Transposition automatique selon règle

Bonjour,

essaie ce code en l'adaptant. Appui sur F8, tu verras les actions

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 26/01/2011 by DLPINTERNETTEST3
'

'
Sheets("Sheet1").Select 'ta feuille de travail remplace sheet1 par ton nom de feuille
Columns("A:B").Select ' le classement de ton tableau, sélectionne les colonnes de A à b
'si tu as un en-tête :
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'si tu n'as pas d'en-tête :
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

i = 1 ' ta ligne ou se trouve ta première référence, si c'est pas 1 mets le numéro de ligne
j = 1 ' ta colonne ou se trouve ta référence si c'est en B mets 2, si c'est en c, mets 3....
a = i + 1
Do While Cells(i, 1) <> "" 'balaie jusqu'à ce que tu n'ais plus de références
If Cells(i, 1) = Cells(a, 1) Then 'compare deux réfrences sur deux lignes
j = 2
Do While Cells(i, j) <> ""
j = j + 1
Loop
Cells(i, j) = Cells(a, 1) 'si c'est égal on la mets sur la même ligne
Rows(a).Select
Selection.Delete Shift:=xlUp 'on supprime la référence doublon
Else
i = i + 1
a = i + 1
End If
Loop

End Sub

Bonjour mélanie,

Je te remercie vivement pour ton code mais d'une part je n'arrive pas à le compiler et d'autre part cela ne résoud pas mon problème puisque je n'ai pas une seuls fois la meme cellules mais des cellules du types "123456-OF", "123456-ON"... Et c'est ces références qui commencent par le même préfixe (ici 123456) que je veux transposer automatiquement.
Désolée, je ne suis certainement pas assez claire...

Mymy