faire un tri

[damien]

bonsoir à tous

je voudrai mettre quelque chose de ce style dans ma macro pour faire mon tri mais il renvoi une erreur.

ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False

Selection.CurrentRegion.Select
Selection.Sort Key1:=Range('A17'), Order1:=xlAscending, Key2:=Range('G17' _
), Order2:=xlAscending, Key3:=Range('C17'), Order3:=xlDescending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

ActiveSheet.Protect DrawingObjects:=true, Contents:=true, Scenarios:=true

voici ma macro


Dim TheDate As Date ' Déclare les variables.
Dim Msg
Dim c As Long
reponse = InputBox('Entrez une date (jj/mm/aaaa)', 'Listing contrôle de puis le... ', Sheets('base peche').Range('A1'))
If IsDate(reponse) Then
TheDate = reponse
UserForm13.Label2 = Date - DateDiff('d', TheDate, Now)
UserForm13.Label3 = 'Récapitulatif contrôles depuis le :' & TheDate
lafin = Worksheets('base peche').Range('A65536').End(xlUp).Row
For N = 1 To lafin
If Worksheets('base peche').Range('A' & N) = CDate(UserForm13.Label2) Then
debut = N
Exit For
End If
Next N
If N = lafin + 1 Then
MsgBox ('La date n'existe pas!')
Call macro1
Else
For N = debut To lafin
UserForm13.ListBox1.AddItem Worksheets('base peche').Range('A' & N)

Next N
For N = 1 To UserForm13.ListBox1.ListCount - 1
UserForm13.ListBox1.List(N - 1, 1) = Worksheets('base peche').Range('c' & N + debut - 1)
UserForm13.ListBox1.List(N - 1, 2) = Worksheets('base peche').Range('d' & N + debut - 1)
UserForm13.ListBox1.List(N - 1, 3) = Worksheets('base peche').Range('e' & N + debut - 1)
UserForm13.ListBox1.List(N - 1, 4) = Worksheets('base peche').Range('f' & N + debut - 1)
UserForm13.ListBox1.List(N - 1, 5) = Worksheets('base peche').Range('g' & N + debut - 1)
UserForm13.ListBox1.List(N - 1, 6) = Worksheets('base peche').Range('j' & N + debut - 1)
UserForm13.ListBox1.List(N - 1, 7) = Worksheets('base peche').Range('o' & N + debut - 1)
UserForm13.ListBox1.List(N - 1, 8) = Worksheets('base peche').Range('p' & N + debut - 1)

Next N
UserForm13.Show
End If
Else
If reponse = '' Then
Exit Sub
Else
MsgBox ('Entrez une date valide!')
Call macro1
End If

End If


merci a tous

 

[pierrejean]

bonjour damien

que veux-tu trier ???

s'il sagit du contenu de ta listbox j'ais des craintes

par contre il est possible de trier d'abord dans la feuille d'origine
si c'est le cas sur quel colonne veux-tu trier

 

[damien]

bonjour pierrejean

je veux trier ma feuille avant que ce sois afficher dans la listbox.
Ma feuil est protege
je tri par rapport en 1 à la colonne A, en 2 colonne G et en 3 colonne C et en suite remettre ma protection.

raison je veux que dans ma listbox que ce sois de la date la plus ancienne à la plus recente.

damien

 

[pierrejean]

re damien

voila la ligne à inserer ou tu le souhaites

Columns('A:C').Sort Key1:=Range('A1'), Order1:=xlDescending, Key2:=Range('B1') _
        , Order2:=xlDescending, Key3:=Range('C1'), Order3:=xlDescending, Header _
        :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

note j'ai mis l'ordre descendant pour les 3 colonnes sinon change
Descending par
Ascending

 

[damien]

bonjour pierrejean

ça ne marche pas j'ai une erreur 1004 la methode Sort de la classe range a echoue.
voici mon code

Sub macro1()
Cells(17.1).Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False

Selection.CurrentRegion.Select
Selection.Sort Key1:=Range('A17'), Order1:=xlAscending, Key2:=Range('G17' _
), Order2:=xlAscending, Key3:=Range('C17'), Order3:=xlDescending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom



ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True


Dim TheDate As Date ' Déclare les variables.
Dim Msg
Dim c As Long
reponse = InputBox('Entrez une date (jj/mm/aaaa)', 'Listing contrôle de puis le... ', Sheets('base peche').Range('A1'))
If IsDate(reponse) Then
TheDate = reponse
UserForm13.Label2 = Date - DateDiff('d', TheDate, Now)
lafin = Worksheets('base peche').Range('A65536').End(xlUp).Row
For N = 1 To lafin
If Worksheets('base peche').Range('A' & N) = CDate(UserForm13.Label2) Then
Debut = N
Exit For
End If
Next N
If N = lafin + 1 Then
MsgBox ('La date n'existe pas!')
Call macro1
Else
For N = Debut To lafin
UserForm13.ListBox1.AddItem Worksheets('base peche').Range('A' & N)
Next N
For N = 1 To UserForm13.ListBox1.ListCount - 1
UserForm13.ListBox1.List(N - 1, 1) = Worksheets('base peche').Range('B' & N + Debut - 1)
UserForm13.ListBox1.List(N - 1, 2) = Worksheets('base peche').Range('C' & N + Debut - 1)
Next N
UserForm13.Show
End If
Else
If reponse = '' Then
Exit Sub
Else
MsgBox ('Entrez une date valide!')
Call macro1
End If

End If


End Sub

merci
damien