XL 2016 Suppression lignes si valeur cellule égale 0

Bonjour @KTM,

Premier point :
Pour des suppressions de lignes, on commence toujours par la dernière ligne pour remonter vers la première. On oublie donc la boucle for Each...Next qui parcourt le range de la première ligne à la dernière. On utilise plutôt une boucle For i = DernièreLigne to PremièreLigne ... Next i (avec Step -1) :


Deuxième point :
Autre erreur avec votre code initial :
monRange.Rows désigne l'ensemble des lignes du range monRange et en aucun cas les lignes entières sur l'ensemble des colonnes de la feuilles.

Dans votre cas, vous utilisez cel.rows. Comme cel est une cellule unique, l'ensemble des lignes de cel est la cellule cel elle-même. Quand vous exécutez cel.Rows.Delete, vous ne supprimez que la cellule cel et en aucun cas vous ne touchez à d'autre cellules de la ligne. Vous ne remontez donc que la colonne E. Vous pourriez utiliser cel.entirerow.delete pour supprimer une ligne entière.

Bonjour
Ta macro corrigée
A+ François

Bonjour KTM, mapomme, fanfan38,

Comme ceci c'est plus propre :
A+

mapomme à dit:

Bonjour @KTM,

Premier point :
Pour des suppressions de lignes, on commence toujours par la dernière ligne pour remonter vers la première. On oublie donc la boucle for Each...Next qui parcourt le range de la première ligne à la dernière. On utilise plutôt une boucle For i = 1 to ... Next i (avec Step -1) :

VB:

   For i = 26 To 5 Step -1
      If .Cells(i, "e") = 0 Then .Rows(i).Delete
   Next i

Deuxième point :
Autre erreur avec votre code initial :
monRange.Rows désigne l'ensemble des lignes du range monRange et en aucun cas les lignes entières sur l'ensemble des colonnes de la feuilles.

Dans votre cas, vous utilisez cel.rows. Comme cel est une cellule unique, l'ensemble des lignes de cel est la cellule cel elle-même. Quand vous exécutez cel.Rows.Delete, vous ne supprimez que la cellule cel et en aucun cas vous ne touchez à d'autre cellules de la ligne. Vous ne remontez donc que la colonne E. Vous pourriez utiliser cel.entirerow.delete pour supprimer une ligne entière.

Cliquez pour agrandir...

Bien compris et Merci !!!

job75 à dit:

Bonjour KTM, mapomme, fanfan38,

Comme ceci c'est plus propre :

VB:

Sub COPIE()
Dim chemin As String, fichier As String, i&
chemin = ThisWorkbook.Path & "\fact\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin
fichier = "Extrait"
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier existe déjà
ThisWorkbook.Sheets("fiche").UsedRange.Copy
With Workbooks.Add(xlWBATWorksheet)
    With .Sheets(1)
        .Cells(1).PasteSpecial Paste:=xlPasteValues
        .Cells(1).PasteSpecial Paste:=xlPasteFormats
        .Cells(1).Select
        Application.CutCopyMode = False
        With Intersect(.[E:E], .UsedRange.EntireRow)
            For i = .Count To 1 Step -1
                If .Cells(i) = 0 Then .Cells(i).EntireRow.Delete
            Next i
        End With
        .Columns.AutoFit
        ActiveWindow.DisplayGridlines = False
        .PageSetup.PrintArea = .UsedRange.Address
        .PageSetup.Orientation = xlPortrait
        .PageSetup.Zoom = False
        .PageSetup.FitToPagesTall = 1
        .PageSetup.FitToPagesWide = 1
        .PageSetup.RightFooter = "&P de &N"
        .PageSetup.LeftMargin = Application.InchesToPoints(0.118110236220472)
        .PageSetup.RightMargin = Application.InchesToPoints(0.118110236220472)
    End With
    .SaveAs chemin & fichier, 51
    .Close
End With
End Sub

A+

Cliquez pour agrandir...

Super Job75 !!

fanfan38 à dit:

Bonjour
Ta macro corrigée

VB:

Sub Copie()
  Application.ScreenUpdating = False
  Dim FCopie As String, FColle As String, i As Long, dl As Long
  Dim chemin As String, fichier As String
  chemin = ThisWorkbook.Path & "\fact\"
  If Dir(chemin, vbDirectory) = "" Then MkDir chemin
  fichier = "Extrait"
  FCopie = ActiveWorkbook.Name
  Application.DisplayAlerts = False
  Application.EnableEvents = False
  Application.Workbooks.Add
  FColle = ActiveWorkbook.Name
  Workbooks(FCopie).Activate
  Sheets("fiche").Select
  Sheets("fiche").Copy After:=Workbooks(FColle).Sheets(1)
  Workbooks(FColle).Sheets(1).Delete
With Workbooks(FColle).Sheets("fiche")
  dl = .Range("E" & Rows.Count).End(xlUp).Row
   For i = dl To 5 Step -1
     If .Range("E" & i).Value = 0 Then .Range("E" & i).EntireRow.Delete
   Next
End With
  ActiveWorkbook.SaveAs chemin & fichier
  Application.DisplayAlerts = True
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

A+ François

Cliquez pour agrandir...

Merci beaucoup !!

La suppression des lignes peut prendre du temps, il vaut mieux filtrer le tableau source :