Trier des valeurs

Salut

en lançant à partir de la feuil1
Sub test()
On Error Resume Next
With Range("C2")
.FormulaLocal = _
"=INDEX(Feuil2!b:b;equiv(Feuil1!a2;Feuil2!a:a;0))"
.AutoFill Destination:=Range("C2:C" & [a65536].End(xlUp).Row)
End With
With Columns("C:C")
.SpecialCells(xlCellTypeFormulas, 16).ClearContents
.Copy
.PasteSpecial Paste:=xlValues
ActiveSheet.Paste
Application.CutCopyMode = False
End With
With Sheets("feuil2")
For i = 2 To .[a65536].End(xlUp).Row
If Application.CountIf(Sheets("Feuil1").Columns(1), .Cells(i, 1)) = 0 Then
ligne = Sheets("Feuil1").[a65536].End(xlUp).Row + 1
Sheets("Feuil1").Cells(ligne, 1) = .Cells(i, 1)
Sheets("Feuil1").Cells(ligne, 3) = .Cells(i, 2)
End If
Next
End With
Range("A2").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes
Columns("B:B").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
End Sub

a+
rural thierry
"beurnoir" <benoit.pommereuil@utbm.fr> a écrit dans le message de news:
1bb4401c42134$d806d940$a501280a@phx.gbl...
Salut tout le monde,

J'aimerais obtenir pour une meme référence tous les prix
(aerien, route) pour celle ci sur une meme ligne.
Dans le cas il n'y a pas de valeur ds la cellule il
faudrait une cellule vide.
En fait, je possede 2 feuilles differentes et j'aimerais
regrouper les colonnes de ces feuilles en fonction des
references communes.
Exemple : Feuille 1
Ref Prix aerien
1 2
3 5
6 1

Feuille 2
Ref Prix total
2 9
1 0
3 4

Et je veux dans une meme feuille :

Ref Prix aerien Prix total
1 2 0
2 9
3 5 4
6 1

Je possède déja la macro suivante mais elle ne realise le
tri que pour la premiere ligne :

Sub regroupement()
Dim c As Range, i As Integer
i = 1
Sheets("Aerien").Select
For Each c In Sheets("Aerien").Range("B2", Range("B2").End
(xlDown))
Sheets("Finale").Select
Sheets("Finale").Range("A2").End(xlUp).Offset(i, 0) = c
Sheets("Finale").Range("A2").End(xlUp).Offset(i, 1) c.Offset(0, 27)
Sheets("Finale").Range("A2").End(xlUp).Offset(i, 2) c.Offset(0, 28)
i = i + 1
Sheets("Aerien").Select
Next

Sheets("Route").Select
For Each c In Sheets("Route").Range("B2", Range("B2").End
(xlDown))
Sheets("Finale").Select
Sheets("Finale").Range("A2").End(xlUp).Offset(i, 0) = c
Sheets("Finale").Range("A2").End(xlUp).Offset(i, 3) c.Offset(0, 27)
Sheets("Finale").Range("A2").End(xlUp).Offset(i, 4) c.Offset(0, 28)
i = i + 1
Sheets("Route").Select
Next

Sheets("Prix").Select
For Each c In Sheets("Prix").Range("B2", Range("B2").End
(xlDown))
Sheets("Finale").Select
Sheets("Finale").Range("A2").End(xlUp).Offset(i, 0) = c
Sheets("Finale").Range("A2").End(xlUp).Offset(i, 5) c.Offset(0, 5)
Sheets("Finale").Range("A2").End(xlUp).Offset(i, 6) c.Offset(0, 6)
i = i + 1
Sheets("Prix").Select
Next

'Tri des valeurs
Sheets("Finale").Select
Range("A2").Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:úlse,
Orientation:=xlTopToBottom

'cas de la 1ère ligne
For Each c In Sheets("Finale").Range("A1:A2")
If c = c.Offset(1, 0) Then
c.Offset(0, 3) = c.Offset(1, 3)
c.Offset(0, 4) = c.Offset(1, 4)
c.Offset(0, 5) = c.Offset(1, 5)
c.Offset(0, 6) = c.Offset(1, 6)
c.Offset(1, 0).EntireRow.Delete
End If
Next

'Comparaison des valeurs et effacement des lignes inutiles
For Each c In Sheets("Finale").Range("A1", Range("A1").End
(xlDown))
If c = c.Offset(1, 0) Then
If c.Offset(0, 3) = "" Then
c.Offset(0, 3) = c.Offset(1, 3)
End If
If c.Offset(0, 4) = "" Then
c.Offset(0, 4) = c.Offset(1, 4)
End If
If c.Offset(0, 5) = "" Then
c.Offset(0, 5) = c.Offset(1, 5)
End If
If c.Offset(0, 6) = "" Then
c.Offset(0, 6) = c.Offset(1, 6)
End If
c.Offset(1, 0).EntireRow.Delete
End If
Next

End Sub

J'aimerais donc avoir soit une nouvelle macro capable de
faire ce tri soit une boucle capable de faire le tri de la
ligne 1 pour toutes les lignes.
J'ai essayé de faire cette boucle rien a faire ca plante.

Merci