Discussion :

[RapTure]

Bonjour,

J'ai un tableau de données que je remplie via une macro VBA voila ce que j'obtiens :

Cependant j'aimerais que mes tableaux soit classés par "Appli" puis par "Date" comme ceci :

J'avais essayé avec ce 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
For i = 1 To nbLigne
    If feuille.Range("A" & i).Value = "EN COURS" Then
        ligneEnC = i
    End If
    If feuille.Range("A" & i).Value = "RESOLUS" Then
        ligneReso = i
    End If
Next
If ligneReso - ligneEnC <> 2 Then
    Range("B" & ligneEnC + 2 & ":B" & ligneReso - 1).CurrentRegion.Sort key1:=Range("B" & ligneEnC + 2 & ":B" & ligneReso - 1), order1:=xlAscending, dataoption1:=xlSortNormal, _
                               key2:=("C" & ligneEnC + 2 & ":C" & ligneReso - 1), order2:=xlAscending, dataoption2:=xlSortNormal, Header:=xlYes
End If
If feuille.Range("A" & ligneReso + 2).Value <> "" Then
    Range("B" & ligneReso + 2 & ":B" & nbligne).CurrentRegion.Sort key1:=Range("B" & ligneReso + 2 & ":B" & nbligne), order1:=xlAscending, dataoption1:=xlSortNormal, _
                               key2:=Range("C" & ligneReso + 2 & ":C" & nbligne), order2:=xlAscending, dataoption2:=xlSortNormal, Header:=xlYes
End If

La première partie du code permet de savoir à quelle ligne se trouve mon bandeau EN COURS ou RESOLUS.
Le deuxième partie me permettrait normalement de trier chacun des deux tableau respectivement sous les deux bandeaux.
Avec ce code une erreur s'affiche et supprime toutes les données de mes tableaux.

Merci d'avance pour votre aide!

Bonne journée.

[mercatog]

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
Sub Tri()
Dim Lc As Long, Lr As Long, Ld As Long
Dim c As Range
 
With Worksheets("Feuil1")                                  ' A ADPATER
    Ld = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set c = .Range("A1:A" & Ld).Find("EN COURS", LookIn:=xlValues, Lookat:=xlWhole)
    If Not c Is Nothing Then
        Lc = c.Row
        Set c = .Range("A"& Lc+1 &":A" & Ld).Find("RESOLUS", LookIn:=xlValues, Lookat:=xlWhole)
        If Not c Is Nothing Then
            Lr = c.Row
            Set c = Nothing
            .Range("A" & Lc + 1 & ":D" & Lr - 1).Sort Key1:=.Range("C" & Lc + 1), Order1:=xlAscending, Key2:=.Range("B" & Lc + 1), Order2:=xlAscending, Header:=xlYes
            .Range("A" & Lr + 1 & ":D" & Ld).Sort Key1:=.Range("C" & Lr + 1), Order1:=xlAscending, Key2:=.Range("B" & Lr + 1), Order2:=xlAscending, Header:=xlYes
        End If
    End If
End With
End Sub

[RapTure]

J'ai essayé votre code cependant rien ne se passe.
Les tables que je ressort sont en réalité un peu plus complètes que celle sur les capture d'écrans. C'est peut être pour cela.
Ou alors c'est peut être parce que j'ai ajouté le code que vous m'avez donné dans mon code déjà existant puisqu'il doit figurer dans une condition If.
J'ai pas mal de code à la base, afin d'obtenir les tableaux en sortie.