Trier dates de la plus grande à la plus petite

JBARBE

XLDnaute Barbatruc
Bonjour à tous,
le bouton "RECHERCHE" me permet d'afficher la boite de dialogue !
lorsque j'ai trouvé le cheval demandé à l'aide de ma boite de dialogue, je clique sur le bouton "inserer ligne"
Cette ligne est insérée juste en dessous la 1ére ligne existante !
Hors dans le cas présent, les dates ne sont pas misent de la plus grande à la plus petite !
Serait-il possible que ces dates soient triées dés l'instant où l'on clique sur le bouton "saisie ligne"
Merci à l'avance et bonne journée !
 

Pièces jointes

  • Cheval1.jpg
    Cheval1.jpg
    333.1 KB · Affichages: 19
  • Cheval2.jpg
    Cheval2.jpg
    341.6 KB · Affichages: 14
  • Cheval3.jpg
    Cheval3.jpg
    356.9 KB · Affichages: 8
  • Chronos chevaux Haies Test.zip
    569.4 KB · Affichages: 4
Dernière édition:

JBARBE

XLDnaute Barbatruc
Re,
J'ai réfléchi en faisant le tri de l'ensemble des lignes et pour chaque cheval avec cette macro qui fonctionne mais qui plante pour :
- .Apply
- .SetRange Range(.Cells(Y, 1), .Cells(X, 13))
VB:
Option Explicit

Sub test()
Dim i As Long, j As Long, X As Long, Y As Long
X = 2
Y = 2
With Sheets("Feuil1")
For j = 3 To 65536
X = X + 1
Y = X
If .Cells(j, 1) = "" Then Exit Sub
For i = 3 To 65536
If .Cells(X, 1) <> .Cells(X + 1, 1) Then
Exit For
Else
X = X + 1
End If
Next i

Range(.Cells(Y, 1), .Cells(X, 13)).Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range(.Cells(Y, 8), .Cells(X, 8)), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range(.Cells(Y, 1), .Cells(X, 13))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Next j
End With
End Sub

Peut-être elle n'aime pas le Cells à la place de range !!!
@+
 

JBARBE

XLDnaute Barbatruc
Bonsoir à tous,
J'ai supprimé les points Cells ici :
.SetRange Range(Cells(Y, 1), Cells(X, 13))
et ajouté à la boucle i :
If .Cells(X, 1) = "" Then Exit Sub
VB:
Option Explicit

Sub trier()
Dim i As Long, j As Long, X As Long, Y As Long
Application.ScreenUpdating = False
X = 2
Y = 2
With Sheets("Feuil1")
For j = 3 To 65536
X = X + 1
Y = X
If .Cells(j, 1) = "" Then Exit Sub
For i = 3 To 65536
If .Cells(X, 1) = "" Then Exit Sub
If .Cells(X, 1) <> .Cells(X + 1, 1) Then
Exit For
Else
X = X + 1
End If
Next i

Range(.Cells(Y, 1), .Cells(X, 13)).Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range(.Cells(Y, 8), .Cells(X, 8)), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range(Cells(Y, 1), Cells(X, 13))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Next j
End With
Application.ScreenUpdating = True
End Sub

Bonne nuit !
 

Discussions similaires