Tri automatique par colonne

**jimbeam** · 16/01/2020, 23h28

Bonjour,

Je suis nouveau sur le forum et dans le monde d'office
Je sollicite votre aide car je suis bloqué avec un tableau que je souhaite réaliser.

J'utilise une macro (que je n'ai pas codée) pour archiver des lignes de mon tableau vers un classeur "archives"
La macro possède une fonction "restaurer". C'est là ou ça ne fonctionne pas comme je le voudrais... excel restaure bien la ligne mais ne la remet pas au bon endroit. J'ai donc eu l'idée de créer une colonne supplémentaire numérotée correspondant a mes lignes spécialement pour le tri.

Je souhaiterai savoir comment trier automatiquement les lignes entières qui ont été restaurés dans l'ordre croissant (en partant de la 4eme ligne). La première cellule des données à trier se trouve en B4.

P.S. si vous avez une solution plus simple pour que excel remette la ligne au bon endroit je suis preneur

Merci beaucoup pour votre temps,
Christian

Voici un aperçu de mon code pour copier les donnés :

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
 Dim myVariable As String, modeDebug As Boolean
    modeDebug = False
 
    If Not modeDebug Then
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
    End If
 
' Comment
If modeDebug Then Stop
 
    Sheets("Planning").Select
    Range("B" & myRow & ":F" & myRow).Copy
    Sheets("Archives").Select
    Range("B100000").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial (xlPasteFormulasAndNumberFormats)
    Cells(Selection.Row, 1) = Date
    Sheets("Planning").Select
    Application.EnableEvents = False
    Range("A" & myRow & ":F" & myRow).Delete Shift:=xlShiftUp
    Application.EnableEvents = True
 
    If Not modeDebug Then
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
    End If
End Sub

**ARTURO83** · 18/01/2020, 10h03

Bonjour,

En supposant que:
- la colonne comportant les N° de lignes est la colonne M
- la première ligne de données(hors ligne d'entêtes) commence en ligne 4, essayez ceci

Code :

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

Range("B4:M" & Range("B" & Rows.Count).End(xlUp).Row).Sort [M1], 1

Vous pouvez aussi utilisez l'enregistreur de macro pour faire le tri, récupérer le code et l'adapter à la plage des cellules.

Cdlt

**jimbeam** · 18/01/2020, 10h32

Bonjour

Merci pur votre retour
J'ai essayé avec le code que vous m'avez donné, mais ça ne fonctionne pas

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
Option Explicit
Option Base 1
Sub archiveRow(myRow As Long)
' **************************************************************************************
' Author        : Christian CROCHE
' Date          : 31/07/2019
' Description   : Ajouter un "x" ou "X" dans la colonne M lance une copie de la ligne
'                 dans la feuille Tâches réalisées et supprime la ligne de la feuille Travail
' **************************************************************************************
 
    Dim myVariable As String, modeDebug As Boolean
    modeDebug = False
 
    If Not modeDebug Then
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
    End If
 
' Comment
If modeDebug Then Stop
 
    Sheets("Rétro planning").Select
    Range("B" & myRow & ":F" & myRow).Copy
    Sheets("Tâches réalisées").Select
    Range("B100000").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial (xlPasteFormulasAndNumberFormats)
    Cells(Selection.Row, 1) = Date
    Sheets("Rétro planning").Select
    Application.EnableEvents = False
    Range("A" & myRow & ":F" & myRow).Delete Shift:=xlShiftUp
    Application.EnableEvents = True
 
 
    If Not modeDebug Then
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
    End If
End Sub
Sub recoverRow(myRow As Long)
' **************************************************************************************
' Author        : Christian CROCHE
' Date          : 01/08/2019
' Description   : Ajouter un "x" ou "X" dans la colonne M lance une copie de la ligne
'                 dans la feuille Travail et supprime la ligne de la feuille Archive
' **************************************************************************************
 
    Dim myVariable As String, modeDebug As Boolean
    modeDebug = False
 
    If Not modeDebug Then
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
    End If
 
' Comment
If modeDebug Then Stop
 
    Sheets("Tâches réalisées").Select
    Range("B" & myRow & ":F" & myRow).Copy
    Sheets("Rétro planning").Select
    Range("B100000").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial (xlPasteFormulasAndNumberFormats)
    Sheets("Tâches réalisées").Select
    Application.EnableEvents = False
    Cells(myRow, 1).EntireRow.Delete Shift:=xlShiftUp
    Application.EnableEvents = True
 
    ' Tri personnalisé
 
Range("B4:B" & Range("B" & Rows.Count).End(xlUp).Row).Sort [B1], 1
 
    'Fin du tri
 
    If Not modeDebug Then
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
    End If
End Sub

J'ai réussi a faire un tri avec l'enregistreur de macro qui fonctionne mais je pense n'est pas parfait.
De plus à la fin de la macro les cellules restent sélectionnées ; je pense que c'est du a la fonction "Range(MaPlage).Select" mais je ne sais pas comment faire sans le .Select

Voici mon code (rudimentaire) qui fonctionne :

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
 
Option Explicit
Option Base 1
Sub archiveRow(myRow As Long)
' **************************************************************************************
' Author        : Christian CROCHE
' Date          : 31/07/2019
' Description   : Ajouter un "x" ou "X" dans la colonne M lance une copie de la ligne
'                 dans la feuille Tâches réalisées et supprime la ligne de la feuille Travail
' **************************************************************************************
 
    Dim myVariable As String, modeDebug As Boolean
    modeDebug = False
 
    If Not modeDebug Then
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
    End If
 
' Comment
If modeDebug Then Stop
 
    Sheets("Rétro planning").Select
    Range("B" & myRow & ":F" & myRow).Copy
    Sheets("Tâches réalisées").Select
    Range("B100000").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial (xlPasteFormulasAndNumberFormats)
    Cells(Selection.Row, 1) = Date
    Sheets("Rétro planning").Select
    Application.EnableEvents = False
    Range("A" & myRow & ":F" & myRow).Delete Shift:=xlShiftUp
    Application.EnableEvents = True
 
 
    If Not modeDebug Then
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
    End If
End Sub
Sub recoverRow(myRow As Long)
' **************************************************************************************
' Author        : Christian CROCHE
' Date          : 01/08/2019
' Description   : Ajouter un "x" ou "X" dans la colonne M lance une copie de la ligne
'                 dans la feuille Travail et supprime la ligne de la feuille Archive
' **************************************************************************************
 
    Dim myVariable As String, modeDebug As Boolean
    modeDebug = False
 
    If Not modeDebug Then
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
    End If
 
' Comment
If modeDebug Then Stop
 
    Sheets("Tâches réalisées").Select
    Range("B" & myRow & ":F" & myRow).Copy
    Sheets("Rétro planning").Select
    Range("B100000").End(xlUp).Offset(1, 0).Select
    Selection.PasteSpecial (xlPasteFormulasAndNumberFormats)
    Sheets("Tâches réalisées").Select
    Application.EnableEvents = False
    Cells(myRow, 1).EntireRow.Delete Shift:=xlShiftUp
    Application.EnableEvents = True
 
    ' Tri personnalisé
 
     Range("A4:F111").Select
    ActiveWorkbook.Worksheets("Rétro planning").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Rétro planning").Sort.SortFields.Add2 Key:=Range( _
        "B4:B111"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Rétro planning").Sort
        .SetRange Range("A4:F111")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    'Fin du tri
 
    If Not modeDebug Then
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
    End If
End Sub

Merci infiniment,
Christian

**ARTURO83** · 18/01/2020, 11h27

Je reprends ma formule avec vos données

Code :

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

    Range("A4:F" & Range("A" & Rows.Count).End(xlUp).Row).Sort [F4], 1

Réessayez

**jimbeam** · 18/01/2020, 11h45

Je suis désolé je ne doit pas faire tout comme il faut, je n'arrive pas à faire fonctionner

Je vous joint tout le fichier pour que vous ayez un aperçu

**ARTURO83** · 18/01/2020, 11h48

D'après votre fichier, essayez ceci

Code :

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

    Range("B4:F" & Range("B" & Rows.Count).End(xlUp).Row).Sort [B4], 1

Tri automatique par colonne

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager