Discussion :

[INFINITY100]

Bonjour à tous

voila je réalisé une macro de tri par ordre alphabétique avec l'enregistreur de macro excel et je cherche à la simplifier le maximum possible

Voici la macro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
ActiveWorkbook.Worksheets("Liste_Fournisseurs").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Liste_Fournisseurs").Sort.SortFields.Add Key:= _
        Range("D12:D" & Derligne), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("Liste_Fournisseurs").Sort.SortFields.Add Key:= _
        Range("C12:C" & Derligne), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Liste_Fournisseurs").Sort
        .SetRange Range("B11:D" & Derligne)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Merci à vous tous

Cordialement

[Docmarti]

Bonjour.

Si la commande SORT te convient :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Tri()
 
 Set Wb = ThisWorkbook
 Set f = Wb.Worksheets("Liste_Fournisseurs")
 Derligne = f.Range("A" & Rows.Count).End(xlUp).Row
 
 Set tableau = f.Range("B11:D" & Derligne)
 
    colKey1 = 3
    colKey2 = 2
 
    tableau.Sort Key1:=tableau.Cells(2, colKey1), Key2:=tableau.Cells(2, colKey2), _
                 Order1:=xlAscending, Order2:=xlAscending, Header:=xlYes, _
                 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
End Sub

[INFINITY100]

Merci Beaucoup Docmarti

C'est bien ce que je cherchais et au test ça fonctionne très bien

Et juste pour le partage voici ma macro en la fusionnant avec l'ensemble de mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Private Sub AjoutNouveauFournisseur_Click()
 
  Dim Ctrl As Control
  Dim r As Integer
  Dim Derligne As Integer
  Dim LigneDebut As Long
 
  'Si le Fourniseurs_TextBox est vide ou c'est une valeur numérique
  If Trim(Fourniseurs_TextBox) = "" Or IsNumeric(Fourniseurs_TextBox) Then
  'Alors arrêt avec ce message en sortant de la boucle et en retourant sur Fourniseurs_TextBox
  MsgBox "Votre cellule est vide ou en format incorrecte! Veuillez le redéfinir", vbCritical
  On Error GoTo 0: Fourniseurs_TextBox.SetFocus: Exit Sub
  End If
  With Worksheets("Liste_Fournisseurs")
      LigneDebut = 12
      Derligne = .Range("C" & Cells.Rows.Count).End(xlUp).Row + 1
        For Each Ctrl In AjoutFournisseurs.Controls
        r = Val(Ctrl.Tag)
                If r > 0 Then .Cells(Derligne, r) = Ctrl
        Next
 
      Fourniseurs_TextBox = ""
      Fourniseurs_TextBox.SetFocus
   End With
 
   'Tri par ordre alphabétique
    Set f = Worksheets("Liste_Fournisseurs")
    Derligne = f.Range("C" & Rows.Count).End(xlUp).Row
 
    Set tableau = f.Range("B11:D" & Derligne)
 
    colKey1 = 3
    colKey2 = 2
 
    tableau.Sort Key1:=tableau.Cells(2, colKey1), Key2:=tableau.Cells(2, colKey2), _
                 Order1:=xlAscending, Order2:=xlAscending, Header:=xlYes, _
                 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
 
    'Actualiser
    Menu.UserForm_Initialize
 
   End Sub

Merci encore cher ami