Macro lente et s'exécute la première fois seulement

Bonjour,

je viens vers vous pour m'aider à corriger le problème de lenteur d'une macro en phase exploitation

Il s'agit d'une mecro pour supprimer les lignes et les colonnes vides en sous total.


En utilisant la macro sur cinq feuilles dans le fichier excel (OF_MP_GM_1 à 5), ce dernier passe beaucoup de temps pour l'exécution.

Est-ce-que vous avez des améliorations à me proposer. Mille est un merci d'avance

Sub SupprimerSousTotalNul()

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Set Feuille = ActiveSheet "Là pour revenir à la feuille d'accueil après l'exécution"

Sheets("OF_MP_GM_1").Select

'Recherche emplacement de Sous total
Set C = Rows("8").Find("S.Total.Commande", LookIn:=xlValues)
If C Is Nothing Then
MsgBox "La colonne ""S.Total.Commande"" est introuvable ou mal orthographiée"
Exit Sub
End If

Set L = Columns("A").Find("S.Total.Bobine", LookIn:=xlValues)
If L Is Nothing Then
MsgBox "La ligne ""S.Total.Bobine"" est introuvable ou mal orthographiée"
Exit Sub
End If

'recherche et suppression des 0 par lignes
For i = L.Row - 1 To 8 Step -1
If Cells(i, C.Column) = 0 Then Cells(i, C.Column).EntireRow.Delete
Next i

'recherche et suppression des 0 par colonnes
For i = C.Column - 1 To 3 Step -1
If Cells(L.Row, i) = 0 Then Range(Cells(8, i), Cells(L.Row, i)).Delete
Next i

Sheets("OF_MP_GM_2").Select

'Recherche emplacement de Sous total
Set C = Rows("8").Find("S.Total.Commande", LookIn:=xlValues)
If C Is Nothing Then
MsgBox "La colonne ""S.Total.Commande"" est introuvable ou mal orthographiée"
Exit Sub
End If

Set L = Columns("A").Find("S.Total.Bobine", LookIn:=xlValues)
If L Is Nothing Then
MsgBox "La ligne ""S.Total.Bobine"" est introuvable ou mal orthographiée"
Exit Sub
End If

'recherche et suppression des 0 par lignes
For i = L.Row - 1 To 8 Step -1
If Cells(i, C.Column) = 0 Then Cells(i, C.Column).EntireRow.Delete
Next i

'recherche et suppression des 0 par colonnes
For i = C.Column - 1 To 3 Step -1
If Cells(L.Row, i) = 0 Then Range(Cells(8, i), Cells(L.Row, i)).Delete
Next i

Sheets("OF_MP_GM_3").Select

'Recherche emplacement de Sous total
Set C = Rows("8").Find("S.Total.Commande", LookIn:=xlValues)
If C Is Nothing Then
MsgBox "La colonne ""S.Total.Commande"" est introuvable ou mal orthographiée"
Exit Sub
End If

Set L = Columns("A").Find("S.Total.Bobine", LookIn:=xlValues)
If L Is Nothing Then
MsgBox "La ligne ""S.Total.Bobine"" est introuvable ou mal orthographiée"
Exit Sub
End If

'recherche et suppression des 0 par lignes
For i = L.Row - 1 To 8 Step -1
If Cells(i, C.Column) = 0 Then Cells(i, C.Column).EntireRow.Delete
Next i

'recherche et suppression des 0 par colonnes
For i = C.Column - 1 To 3 Step -1
If Cells(L.Row, i) = 0 Then Range(Cells(8, i), Cells(L.Row, i)).Delete
Next i

Sheets("OF_MP_GM_4").Select

'Recherche emplacement de Sous total
Set C = Rows("8").Find("S.Total.Commande", LookIn:=xlValues)
If C Is Nothing Then
MsgBox "La colonne ""S.Total.Commande"" est introuvable ou mal orthographiée"
Exit Sub
End If

Set L = Columns("A").Find("S.Total.Bobine", LookIn:=xlValues)
If L Is Nothing Then
MsgBox "La ligne ""S.Total.Bobine"" est introuvable ou mal orthographiée"
Exit Sub
End If

'recherche et suppression des 0 par lignes
For i = L.Row - 1 To 8 Step -1
If Cells(i, C.Column) = 0 Then Cells(i, C.Column).EntireRow.Delete
Next i

'recherche et suppression des 0 par colonnes
For i = C.Column - 1 To 3 Step -1
If Cells(L.Row, i) = 0 Then Range(Cells(8, i), Cells(L.Row, i)).Delete
Next i

Sheets("OF_MP_GM_5").Select

'Recherche emplacement de Sous total
Set C = Rows("8").Find("S.Total.Commande", LookIn:=xlValues)
If C Is Nothing Then
MsgBox "La colonne ""S.Total.Commande"" est introuvable ou mal orthographiée"
Exit Sub
End If

Set L = Columns("A").Find("S.Total.Bobine", LookIn:=xlValues)
If L Is Nothing Then
MsgBox "La ligne ""S.Total.Bobine"" est introuvable ou mal orthographiée"
Exit Sub
End If

'recherche et suppression des 0 par lignes
For i = L.Row - 1 To 8 Step -1
If Cells(i, C.Column) = 0 Then Cells(i, C.Column).EntireRow.Delete
Next i

'recherche et suppression des 0 par colonnes
For i = C.Column - 1 To 3 Step -1
If Cells(L.Row, i) = 0 Then Range(Cells(8, i), Cells(L.Row, i)).Delete
Next i


Feuille.Select

MsgBox "Suppression des commandes nulles effectuée", 64
Exit Sub

Application.Calculation = xlCalculationAutomatic

End Sub 

EDIT : Ajout des balises de code (la coloration syntaxique). Explications disponibles ici : ICI Merci d'y penser dans tes prochains messages.