vymazání řádku Vyřešeno

[butes]

Dobrý den
můžete mi prosím pomoc s kode, který jsem našel někde na netu a funguje, když mám prázdný řádek. Potřeboval bych, ale aby fungoval, když je třeba hodnota buňky určitá konstanta

Kód: Vybrat vše

Sub DeleteBlankRows()

    Const BLANK_COL As String = "A"
    Const FIRST_ROW As Long = 1


    Dim sh As Worksheet
    Dim rg As Range
    Set sh = ActiveSheet ' pro příklad aktivujte list Data1
   
    With sh
        Set rg = .Range(BLANK_COL & CStr(FIRST_ROW), _
                        .Cells(.Rows.Count, BLANK_COL).End(3))
        On Error Resume Next
            rg.SpecialCells(xlBlanks).EntireRow.Delete
            If Err.Number <> 0 Then
                MsgBox "Zadne prazde radky nenalezeny."
                Err.Clear
            End If
        On Error GoTo 0
    End With
   
End Sub

Díky

[Reklama]

[cmuch]

Jedno z mnoha řešení.
Smaže všechny řádky, které ve sloupci B obsahují Smaž

Kód: Vybrat vše

Sub SmazVybraneRadky()
  Dim r As Long

  Application.ScreenUpdating = False

  For r = Rows.Count To 2 Step -1
    If Cells(r, "B") = "Smaž" Then
      Rows(r).Delete
    End If
  Next r

  Application.ScreenUpdating = True
End Sub