Untitled

mail@pastecode.io avatar
unknown
plain_text
a year ago
871 B
2
Indexable
Never
Sub UsunWierszeBezTla()
    Dim arkusz As Worksheet
    Dim wiersz As Range
    Dim doUsuniecia As Range
    
    ' Przejście przez każdy arkusz w skoroszycie
    For Each arkusz In ThisWorkbook.Sheets
        Set doUsuniecia = Nothing
        ' Przejście przez każdy wiersz w arkuszu
        For Each wiersz In arkusz.UsedRange.Rows
            ' Sprawdzenie, czy tło pierwszej komórki w wierszu jest puste
            If wiersz.Cells(1, 1).Interior.Color = xlNone Then
                If doUsuniecia Is Nothing Then
                    Set doUsuniecia = wiersz
                Else
                    Set doUsuniecia = Union(doUsuniecia, wiersz)
                End If
            End If
        Next wiersz
        
        ' Usunięcie wszystkich wierszy bez tła
        If Not doUsuniecia Is Nothing Then doUsuniecia.EntireRow.Delete
    Next arkusz
End Sub