XL 2019 Supprimer les lignes vides de plusieurs feuilles

[Dadi147]

Bonjour , je veux supprimer des lignes à condition qu'il y ait un blanc de la cellule E à T, puis-je faire la même chose sur 3 feuilles de calcul en même temps ?

 

[cp4]

Bonjour, oui c'est faisable avec un peu fichier avec des données factices illustrant ton véritable fichier.

 

[Dadi147]

Bonjour, oui c'est faisable avec un peu fichier avec des données factices illustrant ton véritable fichier.

Merci, c'est un exemple. Supprimer les lignes des feuilles M1, M2, M3 et M4 lorsqu'il y a de l'espace dans les cellules de la colonne E à T

 

[cp4]

Re,

Code à tester

Option Explicit
Option Compare Text
Sub supprimer_lignes_vides()
   Dim Feuil As Worksheet, dl As Integer, i As Integer, Rng As Range, j As Integer, kit As Boolean
   For Each Feuil In ThisWorkbook.Worksheets
      If Feuil.Name <> "data" And Feuil.Name <> "janvier" Then
         With Sheets(Feuil.Name)
            dl = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
            Set Rng = .Range("E7:T" & dl)
            For i = dl To 8 Step -1
               For j = 1 To Rng.Columns.Count
                  Debug.Print .Cells(i, j + 4)
                  If .Cells(i, j + 4).Value = "" Then
                     kit = True
                  Else
                     kit = False
                     Exit For
                  End If
               Next j
               Debug.Print Feuil.Name, i, j, kit
               If kit Then .Rows(i).Delete
            Next i
         End With
      End If
   Next
   MsgBox "Traitement terminé!"
End Sub

Bonne journée.

 

[Dadi147]

Merci pour votre aide. Mais le fichier d'origine contient plus de 20 feuilles. Il sera difficile de toutes les énumérer. Puis-je ajouter un exemple ?
MyArray= Array("Feuil1", "feuil2")

 

[cp4]

Merci pour votre aide. Mais le fichier d'origine contient plus de 20 feuilles. Il sera difficile de toutes les énumérer. Puis-je ajouter un exemple ?
MyArray= Array("Feuil1", "feuil2")

Hé, oui quand on ne pose pas son problème comme il se doit, la réponse ne peut que se rapprochait du résultat réel souhaité.

If Feuil.Name <> "data" And Feuil.Name <> "janvier" Then

Sur cette ligne les feuilles non concernées par la suppression. Je te laisse adapter à ta guise.

Puis-je ajouter un exemple ?
MyArray= Array("Feuil1", "feuil2")

Oui. Mais il faut boucler sur l'array.

Bonne continuation.

 

[job75]

Bonjour Dadi147, cp4,

S'il y a beaucoup de lignes à supprimer la suppression ligne par ligne prend beaucoup de temps.

Voici une macro très rapide grâce aux formules auxiliaires et au tri de regroupement :

Sub Nettoyer()
Dim a, ligdeb&, w As Worksheet, P As Range
a = Array("M1", "M2", "M3", "M4", "M5") 'liste des feuilles à traiter
ligdeb = 7 '1ère ligne à traiter
Application.ScreenUpdating = False
For Each w In Worksheets
    If IsNumeric(Application.Match(w.Name, a, 0)) Then
        Set P = Intersect(w.Rows(ligdeb & ":" & w.Rows.Count), w.UsedRange.EntireRow)
        If Not P Is Nothing Then
            P.Columns(1).Insert xlToRight 'insère une colonne auxiliaire
            P.Columns(1) = "=1/SIGN(SUMPRODUCT(N(RC[5]:RC[20]<>"""")))"
            P.Columns(1) = P.Columns(1).Value 'supprime les formules
            P.Sort P(1), xlAscending, Header:=xlNo 'tri pour regrouper et accélérer
            On Error Resume Next 'si aucune SpecialCell
            P.Columns(1).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete 'supprime les valeurs d'erreur
            P.Columns(1).Delete xlToLeft 'supprime la colonne auxiliaire
            On Error GoTo 0
        End If
    End If
Next
End Sub

A+

 

[Dadi147]

Bonjour. Merci à tous pour votre aide.

 

[cathodique]

Bonjour,

Je suivais la discussion en arrière plan.
Pour le fun, un code à tester, si le nom des feuilles concernées commence par M, sinon adapter.
Le code supprime les lignes filtrées visibles.

Option Explicit

Sub supprimer_lignes_vides_filtrees()
   Dim Sh As Worksheet, i As Integer, Plg As Range
   Application.Calculation = xlManual
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False

   For Each Sh In ThisWorkbook.Worksheets
      If Sh.Name Like "M*" Then
         With Sheets(Sh.Name)
            Set Plg = .Range("A8:T" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row)
            If Not .AutoFilterMode Then .Rows("7:7").AutoFilter
            For i = 5 To 20
               Plg.AutoFilter Field:=i, Criteria1:="="
            Next i
            On Error Resume Next
            Plg.SpecialCells(xlCellTypeVisible).Delete
            On Error GoTo 0
            .AutoFilterMode = False
         End With
      End If
   Next
   MsgBox "Traitement terminé!"

   Application.Calculation = xlAutomatic
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True

End Sub

 

[job75]

Bonjour Dadi147, cp4, cathodique le forum,

Pour tester, sur la 1ère feuille j'ai recopié les lignes 8:21 sur 28 000 lignes.

Durées d'exécution des macros chez moi sur Win 11 Excel 2019 :

- post #4 => 12,8 secondes

- post #7 => 0,3 seconde

- post #9 => 4,7 secondes.

A+