Tri de données sur toutes les feuilles

Bonjour tout le forum,

Il faudrait que je fasse le même tri dans toutes les feuilles d'un classeur quelque soit le nom des feuilles.

J'ai bien essayé de passer par l'enregistrement automatique d'un macro mais cela ne fonctionne pas.

En fait dans chaque feuille, en colonne A se trouvent des dates et en colonne E des heures.

Je souhaiterais trier toutes les données de chaque feuille en fonction de ces deux colonnes : fonction tri personnalisé niveau 1 = Colonne A de la date la plus ancienne à la plus récente ; niveau 2 = Colonne E de l'heure la plus ancienne à la plus récente et ce sur la feuille active ainsi que sur toutes les feuilles qui suivent dans un même classeur.

Merci de votre aide

Bonjour,

Un essai ...

Sub TrierSurAetE()
Dim sh As Worksheet
Dim Dlig As Long, Dcol  As Long
Dim MaFeuil As String

Application.ScreenUpdating = False
MaFeuil = ActiveSheet.Name

For Each sh In ThisWorkbook.Worksheets
    sh.Activate

      Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
          TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
              Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
              :=Array(1, 1), TrailingMinusNumbers:=True

    Dlig = sh.Cells(Rows.Count, "A").End(xlUp).Row
    Dcol = sh.Cells(1, Columns.Count).End(xlToLeft).Column
    sh.Sort.SortFields.Clear

    sh.Sort.SortFields.Add Key:=sh.Range("A1:A" & Dlig), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    sh.Sort.SortFields.Add Key:=sh.Range("E1:E" & Dlig), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With sh.Sort
        .SetRange sh.Range(Cells(1, "A"), Cells(Dlig, Dcol))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Next sh
Worksheets(MaFeuil).Activate
End Sub

ric

Merci Ric,

Mais il m'affiche erreur d'exécution 438

et débogage en jaune, ci-dessous

sh.Sort.SortFields.Add2 Key:=sh.Range("A1:A" & Dlig), _

SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

Bonjour,

Désolé pour la coquille ...

Il faut enlever le 2 dans "Sh.Sort.SortFields.Add2 Key:=" > aux deux endroits.

J'ai corrigé mon code du post précédent.

ric

re,

Ca a l'air de marcher sauf que j'ai apparemment une série de dates qui ne sont pas triées, toujours la même série dans toutes les feuilles et pour cause, après vérification, cette série est au format standard et j'ai un nombre incalculables de feuilles et de données à traiter.

Je pense à un complément de code permettant de faire en sorte que toutes les cellules des colonnes A de toutes les feuilles d'un même classeur soient au format "date" avant d'effectuer le tri du code précédent.

C'est envisageable ?

Un grand merci quoi qu'il arrive, quelque soit ta réponse

Bonjour,

Je n'ai pas de fichier pour tester ...

Un essai ...

J'ai modifié le code que j'ai soumis plus haut ... juste sous "Sh.Activate".

ric

Bonjour,

Une autre méthode ...

Sub TrierSurAetE()
Dim sh As Worksheet
Dim Dlig As Long, Dcol As Long
Dim MaFeuil As String
Dim Plage As Range, i As Long, Cell As Range

    Application.ScreenUpdating = False
    MaFeuil = ActiveSheet.Name

    For Each sh In ThisWorkbook.Worksheets
        sh.Activate
        Dlig = sh.Cells(Rows.Count, "A").End(xlUp).Row
        Dcol = sh.Cells(1, Columns.Count).End(xlToLeft).Column

        ' convertir les dates
        Set Plage = Range("A1:A" & Dlig)
        For Each Cell In Plage.Cells
            On Error GoTo CellSuivante
            Cell = CDate(Cell.Value)
CellSuivante:
        Next Cell

        ' suite après conversion des dates
        sh.Sort.SortFields.Clear
        sh.Sort.SortFields.Add Key:=sh.Range("A1:A" & Dlig), _
                               SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

        sh.Sort.SortFields.Add Key:=sh.Range("E1:E" & Dlig), _
                               SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

        With sh.Sort
            .SetRange sh.Range(Cells(1, "A"), Cells(Dlig, Dcol))
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

    Next sh
    Worksheets(MaFeuil).Activate
End Sub

Oupsssssssssssssssssss,

Là je viens de laisser mouliner pendant 15mn avant de faire "Echap".

Message de débogage en jaune ci-dessous :

Next Cell

Bonjour,

... Là je viens de laisser mouliner pendant 15mn avant de faire "Echap". ...

Est-ce avec mon dernier code ?

Combien de lignes y a-t-il à traiter ?

ric

Oui, avec le dernier code.

3000 lignes environ à traiter par feuilles et une cinquantaine de feuilles

Bonjour,

Je présume qu'il y a 3 tonnes de formules et plusieurs macros événementielles.

Un essai en désactivant temporairement les macros événementielles et les calculs.

Sub TrierSurAetE()
Dim sh As Worksheet
Dim Dlig As Long, Dcol As Long
Dim MaFeuil As String
Dim Plage As Range, i As Long, Cell As Range

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    MaFeuil = ActiveSheet.Name

    For Each sh In ThisWorkbook.Worksheets
        sh.Activate
        Dlig = sh.Cells(Rows.Count, "A").End(xlUp).Row
        Dcol = sh.Cells(1, Columns.Count).End(xlToLeft).Column

        ' convertir les dates
        Set Plage = Range("A1:A" & Dlig)
        For Each Cell In Plage.Cells
            On Error GoTo CellSuivante
            Cell = CDate(Cell.Value)
CellSuivante:
        Next Cell

        ' suite après conversion des dates

        sh.Sort.SortFields.Clear
        sh.Sort.SortFields.Add Key:=sh.Range("A1:A" & Dlig), _
                               SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

        sh.Sort.SortFields.Add Key:=sh.Range("E1:E" & Dlig), _
                               SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

        With sh.Sort
            .SetRange sh.Range(Cells(1, "A"), Cells(Dlig, Dcol))
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

    Next sh
    Worksheets(MaFeuil).Activate

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

ric

Yeeeppp,

J'ai relancer ton code avant d'aller me coucher et finalement cela prenait 20mn et ce parce que j'avais un bug sur une de mes colonnes où une formule était copiée à l'infini... Celui d'excel dans ses limites.

Tout st rentré dans l'ordre.

A nouveau un grand merci à toi.

Bonne journée