Makro pro odstranění prázdných řádků v listu

Toto makro použijeme, chceme-li v listu nechat pouze řádky, ve kterých něco je, a ostatních se zbavit – tedy tabulku “setřepat”.

Makro se prostě spustí a zafunguje, nic dalšího nepotřebujeme.

Sub odstranit_prazdne_radky()
ActiveSheet.UsedRange.Select
Dim i As Long
'Vypneme prepocitovani, aby se makro zbytecne nezpomalovalo
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
'Prochazime rakdy a odstranujeme
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.counta(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
'Zase zapneme prepocitavani
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

 

2 Komentářů

  1. Modifikované makro pro odstranění prázdných řádků (mimo prvního, pokud je prázdný)-rychlejší:
    Sub OdstranPrazdneR()
    ‘odstranit_prazdne_radky()
    Dim problast As Range
    Set problast = ActiveSheet.UsedRange
    poslradek = problast.Rows.Count
    prazdsl = problast.Columns.Count + 1
    ‘Prochazime radky a prazdne oznacime do sloupce vedle pouzite oblasti
    For i = 2 To poslradek
    If WorksheetFunction.CountA(Rows(i)) = 0 Then Cells(i, prazdsl) = “p”
    Next i
    ‘filtrem oznacene radky vybereme a odstranime
    Set problast = ActiveSheet.UsedRange
    problast.AutoFilter
    problast.AutoFilter Field:=prazdsl, Criteria1:=””
    Range(“2:” & Trim(Str(poslradek))).Delete
    problast.AutoFilter
    End Sub

  2. Špatně se zkopíroval řadek – oprava:
    problast.AutoFilter Field:=prazdsl, Criteria1:=”=p”

Komentáře není možné přidávat