Accelerer une macro

[GrandDavid]

Bonjour le forum.
J'ai cherché et trouvé un code qui me permet de ventiler les données de mon classeur dans les différentes feuilles qui le composent. Malheureusement, l'exécution du code est tres long et ralenti mon travail. J'ai une centaine de ligne et presque 30 feuilles. Comment puis je accélérer mon code.

 

[GrandDavid]

Pardonnez-moi, mais j'ai oublié de joindre mon fichier.
je sais que ce sujet a été déjà ouvert dans d'autres posts, mais j'ai essayé d'adapter les différentes solution. faut croire que je suis un peu manchot.
En fait je cherche à automatiser la gestion des frais des élèves d'une petite école et je souhaiterai simplifier la tâche de ceux qui devront utiliser le fichier, étant donné qu'ils ne maîtrisent pas du tout excel. en plus, je voudrais avancer pas à pas avant d'integrer le tout dans l'ensemble.

L'aide de quiconque le voudra sera d'un grand apport. je vous en prie,
voilà donc le fichier joint.

Merci de vous pencher sur mon cas.

Dim j As Integer
Dim Lastrow As Integer
Dim DerniereLigne As Integer

Sub Ventilation()

        Application.EnableEvents = False: Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        
'Boucle permettant de lire toutes les 24 feuilles du classeur
    For j = 4 To 29
    
            Sheets(j).Select
            Lastrow = Range("A1048576").End(xlUp).Row
            For i = Lastrow To 6 Step -1 'Parcourir les lignes en remontant vers le haut
                Sheets(j).Select
                Rows(i).Select
                Selection.Delete shift:=xlUp
            Next i
            
            Sheets("PERCU").Select
            DerniereLigne = Range("A1048576").End(xlUp).Row
            
            For k = 6 To DerniereLigne
                Sheets("PERCU").Select
                If Sheets(j).Name = Cells(k, 4).Value Then
                
                    Rows(k).Select
                    Selection.Copy
                    
                    Sheets(j).Select
                    Lastrow = Range("A1048576").End(xlUp).Row + 1
                    Cells(Lastrow, 1).Select
                    ActiveSheet.Paste
                
                End If
                
            Next k
            
            Sheets("PERCU").Select
            Application.CutCopyMode = False
            Application.EnableEvents = True: Application.ScreenUpdating = True
            Application.Calculation = xlCalculationAutomatic
  
  
    Next j
  
End Sub

 

[GrandDavid]

Bonjour à tous.

si quelqu'un peut me prendre en pitié et me permettre d'avancer dans la correction de ce code, ime sauverait la vie.