Accelerer une macro

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