Tri des feuilles selon 3 valeurs

marie49

XLDnaute Occasionnel
Bonjour,
J'ai réalisé une macro qui permet de faire un tri des feuilles selon 3 valeurs se trouvant sur chaque feuille.

Cette macro marche bien sauf que si on fait plusieurs tris à la suite, son exécution est longue. Cela commence même au deuxième tri.

Quelqu'un aurait-il une idée pour éviter cette lenteur?

Voici le code :
Code:
Sub TriFiche()


'Cette méthode utilise la feuille Menu du fichier "Tri des feuilles selon 3 valeurs.xls" pour
'insérer le nom des feuilles avec le module, le niveau et le numéro d'ordre
' sur les lignes à partir de la ligne 40
'le tri se fait d'abord sur ces lignes
'Ensuite on répercute l'ordre avec les différentes feuilles
'A la fin on met un lien vers chaque feuille

On Error Resume Next
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


Dim i, j, NbrLig As Integer
Dim A As String
Dim Rng As Range


With Workbooks("Tri des feuilles selon 3 valeurs.xls")
    Application.StatusBar = "Début du tri des fiches"
    
    'suppression des lignes dans le fichier menu à partir de la ligne 40
    NbrLig = .Sheets("Menu").Range("B35536").End(xlUp).Row
    .Sheets("Menu").Activate
    ActiveSheet.Range("A40:IV" & NbrLig).Select
    Application.EnableEvents = False 'désactive les actions automatiques du fichier ficenseignement
    Selection.Delete Shift:=xlUp
    
    For i = 2 To .Worksheets.Count 'Ecrit dans la feuille Menu le nom des feuilles, le module, l'ue et l'ordre
        .Sheets("Menu").Cells(i + 38, 1).Value = .Worksheets(i).Name 'le nom de la feuille
        .Sheets("Menu").Cells(i + 38, 4).Value = .Worksheets(i).Cells(4, 3).Value 'le module
        .Sheets("Menu").Cells(i + 38, 2).Value = .Worksheets(i).Cells(3, 9).Value 'le niveau
        .Sheets("Menu").Cells(i + 38, 3).Value = .Worksheets(i).Cells(1, 9).Value 'le numéro d'ordre
    
    Next i
    
    'réalisation du tri dans le fichier Menu
    Application.StatusBar = "Début du tri des fiches;partie2"

    j = i + 37
    A = "A40:D" & j
    .Sheets("Menu").Activate
    ActiveSheet.Range(A).Select
    'ordre de tri : Module,Niveau et Numéro d'ordre
    Selection.Sort Key1:=Range("D40"), Order1:=xlAscending, Key2:=Range("B40" _
        ), Order2:=xlAscending, Key3:=Range("C40" _
        ), Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    
    'Déplacement des feuilles selon leur place dans le tri
    Application.StatusBar = "Déplacement des feuilles  ; partie3"

    For i = .Worksheets.Count To 2 Step -1
        A = .Sheets("Menu").Cells(i + 38, 1).Value
        .Sheets(A).Move After:=Sheets(i - 1)
    Next i
    
    'Ajout d'un lien direct vers la feuille concernée dans la liste de la feuille Menu
    Application.StatusBar = "Trifiche: ajout d'un lien  ; partie4"

    For i = 2 To .Worksheets.Count
        .Sheets("Menu").Hyperlinks.Add Anchor:=.Sheets("Menu").Cells(i + 38, 1), Address:="", SubAddress:= _
        .Sheets("Menu").Cells(i + 38, 1).Value & "!A1", TextToDisplay:=.Sheets("Menu").Cells(i + 38, 1).Value
    Next i
 
    .Sheets("Menu").Select
    Application.EnableEvents = True
 
    .Save
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub


Je me suis déjà inspiré de ce que j'ai trouvé sur le forum...en passant par une feuille menu où je met toutes les informations permettant de faire le tri et ensuite je répercute l'ordre des feuilles dans le fichier.

Merci de votre aide

Marie
 

Discussions similaires

Statistiques des forums

Discussions
312 415
Messages
2 088 236
Membres
103 777
dernier inscrit
ddyyff