VBA trier en fonction d'une colonne

Le 17/11/2022 à 12:32

Bonjour,

J'ai un code qui ne fonctionne pas... mais pourquoi ? C'est à partir de "trier en fonction de la colonne E" que ça bogue.

Sub Trier_ISSIN()

Dim onglet As Worksheet
Dim derniere_ligne As Long
Dim derniere_colonne As Long

'identifieronglet
Set onglet = Sheets("ISSIN")

'Trouver les limites du tableau
derniere_ligne = onglet.Cells(1, Columns.Count).End(xlUp).Row
derniere_colonne = onglet.Cells(1, Columns.Count).End(xlToLeft).Column

'Trier en fonction de la colonne E
onglet.Range(onglet.Cells(5, 19), onglet.Cells(derniere_ligne, derniere_colonne)).Sort _
    Key1:=onglet.Range("A19"), order1:=xlAscending, Header:=xlYes

End Sub••••ˇˇˇˇ

Voici une capture du tableau qui est identique à PLANNING.

Il y a également 8 onglets violets qui comportent le même tableau, à la différence près qu'ils ne contiennent que 8 colonnes (A:H)

capture d ecran 2022 11 16 a 20 37 05

Voici donc mon 2° problème : je souhaite adapter ce code pour qu'il me trie aussi PLANNING et les onglets violets

3° Problème : Je souhaite intégrer la macro qui trie la cinquième colonne des tableaux dans la macro EnregistrerPlanning que voici.

Cette Macro me permet de copier / coller le planning dans ISIN et dans la ville du lieu d'intervention.

Est-ce que je vais devoir faire une macro de trie pour chaque tableau avant chaque "End With" ou y a t-il un moyen plus efficace ? Et dois-je bien mettre cette macro là où je le pense ?

D'ailleurs, est-ce possible de simplifier cette macro ? Je ne suis pas experte et là je trouve qu'elle commence à être longue par rapport à ce que j'ai l'habitude de voir, non ?

Sub EnregistrerPlanning()
' Macro7 Macro
Dim col As Byte

Sheets("ISSIN").Unprotect 'feuille Issin

With Sheets("ISSIN").ListObjects("TabPLANNING16") 'feuille Issin
    If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 11
        .DataBodyRange.Item(lig, col) = Sheets("PLANNING").Cells(ActiveCell.Row, col)
    Next col
End With
With Sheets("MANTESLAJOLIE").ListObjects("Tableau212") 'feuille Mantes
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("PLANNING").Cells(ActiveCell.Row, 2) = "MANTESLAJOLIE" Then .DataBodyRange.Item(lig, col) = Sheets("PLANNING").Cells(ActiveCell.Row, col)
    Next col
End With

With Sheets("GARGES").ListObjects("Tableau213") 'feuille GARGES
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("PLANNING").Cells(ActiveCell.Row, 2) = "GARGES" Then .DataBodyRange.Item(lig, col) = Feuil12.Cells(ActiveCell.Row, col)
    Next col
End With

With Sheets("NANTERRE").ListObjects("Tableau2") 'feuille NANTERRE
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("PLANNING").Cells(ActiveCell.Row, 2) = "NANTERRE" Then .DataBodyRange.Item(lig, col) = Sheets("PLANNING").Cells(ActiveCell.Row, col)
    Next col
End With

With Sheets("VERSAILLES").ListObjects("Tableau25") 'feuille VERSAILLES
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("planning").Cells(ActiveCell.Row, 2) = "VERSAILLES" Then .DataBodyRange.Item(lig, col) = Sheets("PLANNING").Cells(ActiveCell.Row, col)
    Next col
End With

With Sheets("CERGY").ListObjects("Tableau258") 'feuille CERGY
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("PLANNING").Cells(ActiveCell.Row, 2) = "CERGY" Then .DataBodyRange.Item(lig, col) = Feuil12.Cells(ActiveCell.Row, col)
    Next col
End With

With Sheets("ANTONY").ListObjects("Tableau29") 'feuille ANTONY
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("PLANNING").Cells(ActiveCell.Row, 2) = "ANTONY" Then .DataBodyRange.Item(lig, col) = Sheets("PLANNING").Cells(ActiveCell.Row, col)
    Next col
End With

With Sheets("PARIS").ListObjects("Tableau210") 'feuille PARIS
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("PLANNING").Cells(ActiveCell.Row, 2) = "PARIS" Then .DataBodyRange.Item(lig, col) = Sheets("PLANNING").Cells(ActiveCell.Row, col)
    Next col
End With

With Sheets("CRETEIL").ListObjects("Tableau211") 'feuille CRETEIL
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("PLANNING").Cells(ActiveCell.Row, 2) = "CRETEIL" Then .DataBodyRange.Item(lig, col) = Sheets("PLANNING").Cells(ActiveCell.Row, col)
    Next col
End With

With Sheets("PLANNING").ListObjects("TabPLANNING")
    Rows(ActiveCell.Row).Delete
End With

Sheets("ISSIN").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("PLANNING").Select

End Sub

Merci à ceux qui voudront bien me guider sur ce long chemin

Le 17/11/2022 à 12:48

Bonjour

Le fichier serait beaucoup plus utile que des captures d'écran.

Le 17/11/2022 à 13:46
13classeur4.zip (187.16 Ko)

Voilà ! Merci

Le 17/11/2022 à 15:17

Bonjour,

ci-dessous code pour le tri

Sub Trier_ISSIN()

'Trier en fonction de la colonne E
    With [TabPLANNING16].ListObject
        .Range.Sort Key1:=.ListColumns("DATE D'INTERVENTION"), Order1:=xlAscending, Header:=xlYes
    End With

End Sub

Rremarque : Un tableau structuré ne doit pas comporter des lignes vides car il est par construction borné par le nombre de lignes et de colonnes

Le 17/11/2022 à 20:32

Merci beaucoup, ça marche !

J'ai fait des "Call" sans savoir si c'était utile... est-ce que ça l'est ?

Sub EnregistrerPlanning()
' Macro7 Macro
Dim col As Byte

Sheets("ISSIN").Unprotect 'feuille Issin

With Sheets("ISSIN").ListObjects("TabPLANNING16") 'feuille Issin
    If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 12
        .DataBodyRange.Item(lig, col) = Sheets("PLANNING").Cells(ActiveCell.Row, col)
    Next col
End With

With Sheets("MANTESLAJOLIE").ListObjects("Tableau212") 'feuille Mantes
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("PLANNING").Cells(ActiveCell.Row, 2) = "MANTESLAJOLIE" Then .DataBodyRange.Item(lig, col) = Sheets("PLANNING").Cells(ActiveCell.Row, col)
    Next col
End With

Call Trier_MANTES

With Sheets("GARGES").ListObjects("Tableau213") 'feuille GARGES
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("PLANNING").Cells(ActiveCell.Row, 2) = "GARGES" Then .DataBodyRange.Item(lig, col) = Feuil12.Cells(ActiveCell.Row, col)
    Next col
End With

Call Trier_GARGES

With Sheets("NANTERRE").ListObjects("Tableau2") 'feuille NANTERRE
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("PLANNING").Cells(ActiveCell.Row, 2) = "NANTERRE" Then .DataBodyRange.Item(lig, col) = Sheets("PLANNING").Cells(ActiveCell.Row, col)
    Next col
End With
Call Trier_NANTERRE

With Sheets("VERSAILLES").ListObjects("Tableau25") 'feuille VERSAILLES
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("planning").Cells(ActiveCell.Row, 2) = "VERSAILLES" Then .DataBodyRange.Item(lig, col) = Sheets("PLANNING").Cells(ActiveCell.Row, col)
    Next col
End With
Call Trier_VERSAILLES

With Sheets("CERGY").ListObjects("Tableau258") 'feuille CERGY
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("PLANNING").Cells(ActiveCell.Row, 2) = "CERGY" Then .DataBodyRange.Item(lig, col) = Feuil12.Cells(ActiveCell.Row, col)
    Next col
End With
Call Trier_CERGY

With Sheets("ANTONY").ListObjects("Tableau29") 'feuille ANTONY
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("PLANNING").Cells(ActiveCell.Row, 2) = "ANTONY" Then .DataBodyRange.Item(lig, col) = Sheets("PLANNING").Cells(ActiveCell.Row, col)
    Next col
End With
Call Trier_ANTONY

With Sheets("PARIS").ListObjects("Tableau210") 'feuille PARIS
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("PLANNING").Cells(ActiveCell.Row, 2) = "PARIS" Then .DataBodyRange.Item(lig, col) = Sheets("PLANNING").Cells(ActiveCell.Row, col)
    Next col
End With
Call Trier_PARIS

With Sheets("CRETEIL").ListObjects("Tableau211") 'feuille CRETEIL
If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    'Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    Else: .ListRows.Add Position:=1: lig = 1 'insérer a la 1igne 1
    End If

    For col = 1 To 8
 If Sheets("PLANNING").Cells(ActiveCell.Row, 2) = "CRETEIL" Then .DataBodyRange.Item(lig, col) = Sheets("PLANNING").Cells(ActiveCell.Row, col)
    Next col
End With
Call Trier_CRETEIL

With Sheets("PLANNING").ListObjects("TabPLANNING")
    Rows(ActiveCell.Row).Delete
End With

Call Trier_PLANNING

Sheets("ISSIN").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("PLANNING").Select

End Sub
Le 17/11/2022 à 23:26

J'ai fait des "Call" sans savoir si c'était utile... est-ce que ça l'est ?
Dans ce cas, pas vraiment puisqu’une seule ligne d'instruction est nécessaire.

ci-dessous votre code relooké :

Sub EnregistrerPlanning()
' Macro7 Macro
    Dim col As Byte
    Dim ligne_ts As ListRow, ligne_planning As ListRow
    Dim i As Integer

    '// ligne active du tableau structuré Planning
    With [TabPLANNING].ListObject
        i = ActiveCell.Row - .HeaderRowRange.Row
        Set ligne_planning = .ListRows(i)   '
    End With

    '// remplissage du tableau structuré relatif à la feuille ISSIN
    With Sheets("ISSIN")
        .Unprotect 'feuille Issin

        With .ListObjects("TabPLANNING16")  'tableau structuré Issin
            Set ligne_ts = .ListRows.Add(Position:=1) 'insérer a la 1igne 1
            lig = ligne_ts.Index
            For col = 1 To 12
                .DataBodyRange(lig, col) = ligne_planning.Range(, col)
            Next col
        End With

    End With

    '// remplissage du tableau structuré relatif à la ville sélectionnée
    Select Case ligne_planning.Range(, 2).Value

        Case "MANTESLAJOLIE"
        ajouter_ligne_ville [Tableau212].ListObject, ligne_planning

        Case "GARGES"
        ajouter_ligne_ville [Tableau213].ListObject, ligne_planning

        Case "NANTERRE"
        ajouter_ligne_ville [Tableau2].ListObject, ligne_planning

        Case "VERSAILLES"
        ajouter_ligne_ville [Tableau25].ListObject, ligne_planning

        Case "CERGY"
        ajouter_ligne_ville [Tableau258].ListObject, ligne_planning

        Case "ANTONY"
        ajouter_ligne_ville [Tableau29].ListObject, ligne_planning

        Case "PARIS"
        ajouter_ligne_ville [Tableau210].ListObject, ligne_planning

        Case "CRETEIL"
        ajouter_ligne_ville [Tableau211].ListObject, ligne_planning

    End Select

    '// Suppression ligne planning active + tri planning
    ligne_planning.Delete
    Call Trier_PLANNING

    '// Protection feuille ISSIN
    Sheets("ISSIN").Protect

End Sub

Sub ajouter_ligne_ville(TS As ListObject, ligne As ListRow)

    With TS 'tableau structuré
        Set ligne_ts = .ListRows.Add(Position:=1) 'insérer a la 1igne 1
        lig = ligne_ts.Index
        For col = 1 To 8
            .DataBodyRange(lig, col) = ligne.Range(, col)
        Next col
        .Range.Sort Key1:=.ListColumns("DATE D'INTERVENTION"), Order1:=xlAscending, Header:=xlYes
    End With

End Sub

Par ailleurs, il serait bienvenu d'identifier correctement vos tableaux structurés avec le nom de ville correspondant. Exemple : TAB_Mantes_la_jolie au lieu de Tableau212.

Le 18/11/2022 à 09:02

Merci pour ce relooking. Si tu as encore un peu de temps, j'aimerais comprendre une chose. On m'a dit sur le forum qu'en général, il fallait au maximum éviter les "Select" qui ralentissent la machine. Et là, alors que dans ton premier code Trier_ISSIN, il n'y en avait aucun... tu en enchaines 9. Alors pourquoi c'est quand même mieux ?

Le 18/11/2022 à 09:18

On m'a dit sur le forum qu'en général, il fallait au maximum éviter les "Select" qui ralentissent la machine
Il ne s'agit pas du même "Select".
Les "Select" à éviter sont ceux relatifs à l'action d'une sélection de cellule : Range ("A1'").Select , ou d'une plage : Range ("A1:C1'").Select, ou d'une feuille : Sheets("ISSIN").Select. Cela correspond à l'application de la méthode (action) SELECT aux classes Range et Sheets.

Le "Select" que j'ai utilisé est une instruction de même nature que le If ... Else. Elle permet de multiples tests conditionnels qui sont plus compliqués avec un IF.

Rechercher des sujets similaires à "vba trier fonction colonne"