XL 2016 Supprimer ligne si chaque valeur dans les colonnes =0

[AGDALT]

Bonjour,

Je souhaite dans mon fichier supprimer les lignes où j'ai la valeur 0 dans chacune des 12 colonnes (1 colonne= 1mois).
Il se peut qu'un mois ait pour valeur 10 et un autre mois pour valeur -10, dans ce cas, je souhaite que la ligne reste et ne soit pas supprimée. Il ne faut donc pas faire de somme des 12 mois.
De plus, les 12 mois sont entre la colonne C et N mais si ces cellules font chacune zero, je voudrais supprimer la ligne entière (de colonne A à Z).

J'ai réussi à faire une macro qui fait le job mais l'éxecution est vraiment trop longue (10min). Il y a environ 6000 lignes et il en reste 1800 à la fin.

Auriez-vous une astuce pour raccourcir le temps d'éxecution?

Voila ce que j'ai écrit :

Sub Useless_Lines()

Application.ScreenUpdating = False
Dim iCalcul As Integer
iCalcul = Application.Calculation
Application.Calculation = False


'DELETE LINES WITH ZERO
Sheets("Forecast BI").Activate
Dim NbLine As Integer
Dim i As Integer
NbLine = Range("T" & Rows.Count).End(xlUp).Row

For i = NbLine To 1 Step -1
If Cells(i, 3) = 0 And Cells(i, 4) = 0 And Cells(i, 5) = 0 And Cells(i, 6) = 0 And Cells(i, 7) = 0 And Cells(i, 8) = 0 And Cells(i, 9) = 0 And Cells(i, 10) = 0 And Cells(i, 11) = 0 And Cells(i, 12) = 0 And Cells(i, 13) = 0 And Cells(i, 14) = 0 Then Rows(i).Delete
Next i

Application.Calculation = iCalcul
Application.ScreenUpdating = True



Merci d'avance,

 

[Efgé]

Re à tous
On peux réduire le temps de traitement en remplaçant

 For Col = 3 To 13
        If TMp(i, Col) <> 0 Then Flg = True
 Next Col

par

For Col = 3 To 13
 If TMp(i, Col) <> 0 Then
    Flg = True
    Exit For
 End If
Next Col

Ce qui peut gagner quelques dixièmes de secondes; mais est-ce bien utile ?

Cordialement

 

[mapomme]

Bonjour à tous ,

Une autre méthode assez rapide et sans tableau.

Sub Supprligne0()
Dim derLig&, macol&
   Application.ScreenUpdating = False
   With Sheets("Forecast BI")
      If .FilterMode Then .ShowAllData
      derLig = .Cells(.Rows.Count, "t").End(xlUp).Row
      macol = .UsedRange.Column + .UsedRange.Columns.Count
      On Error GoTo ERREUR
      .Columns(macol).Resize(derLig).Formula = "=IF(SUMPRODUCT(ABS(c1:n1))=0,NA(),ROW())"
      .Columns(macol).Resize(derLig).Value = .Columns(macol).Resize(derLig).Value
      .Range(.Cells(1, "a"), .Cells(derLig, macol)).Sort key1:=.Cells(1, macol), order1:=xlAscending, Header:=xlNo
      On Error Resume Next
      .Columns(macol).Resize(derLig).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
      On Error GoTo ERREUR
      .Columns(macol).Delete
      MsgBox "sur " & Format(derLig, "#,##0") & " lignes, " & vbLf & _
      Format((derLig - Application.CountA(Columns("t:t"))), "#,##0") & " ont été supprimées."
      Exit Sub
ERREUR:
      MsgBox "Une erreur s'est produite : " & Err.Description
      .Columns(macol).Delete
   End With
End Sub