Supprimer lignes vides
Catégorie : Cel / Col / Lig
Publié par veriland le 09-Aug-2013 22:40

Deux exemples pour supprimer ou masquer en bloc des lignes vides d'une feuille ...

 

1° exemple SUPPRIMER :

Partie à placer dans un module ...

module



'*****************************************************************************
'supprimer des lignes vides
'*****************************************************************************

Option Explicit
'VériTi
'http://www.excel.veriti.net
Sub SupprLigneVides()
      Dim Ligne As Variant
      Dim Num As Variant
      'geler l'écran
      Application.ScreenUpdating = False
      'UsedRange représente la plage utilisée dans la feuille de calcul
      With ActiveSheet.UsedRange
            'on part de la dernière ligne de la plage qui contient une valeur
            Ligne = .Row + .Rows.Count - 1
      End With
      'on commence la boucle par le bas
      For Num = Ligne To 1 Step -1
            'si ligne vide on supprime
            If Application.CountA(Rows(Num)) = 0 Then Rows(Num).Delete
            'continuer la boucle
      Next Num
      'rétablir écran
      Application.ScreenUpdating = True
End Sub
 

2° exemple MASQUER :

Partie à placer dans un module ...

module




'*****************************************************************************
'masquer des lignes vides
'*****************************************************************************

Option Explicit
'VériTi
'http://www.excel.veriti.net
Sub CacherLigne()
      Dim Cellule As Range
      Dim Zone As Variant
    'geler l'écran
      Application.ScreenUpdating = False
      'Définir zone (ici colonne A jusqu'à 1000)
      Set Zone = Range("A1", Range("A1000").End(xlUp))
      'on commence la boucle sur les Cellules de Zone
      For Each Cellule In Zone
            'si cellule différente de 0 malgré formule alors masquer
            If Cellule.Value = Formula Then Cellule.EntireRow.Hidden = True
            'on continue la boucle
      Next Cellule
      'rétablir écran
      Application.ScreenUpdating = True
End Sub