テーブルから、行すべてのセルが空白の場合にその行を削除するサブルーチン
以下がタイトルのサブルーチンです。
Private Sub TableRowBlankToDelete(ByRef tbl As ListObject)
    Dim rng As Range
    Dim rowToDelete As Range
    Dim cell As Range
    Dim Row As Range
    ' データボディの範囲を取得
    Set rng = tbl.DataBodyRange
    ' 各行に対して処理
    For Each Row In rng.Rows
        ' 行内のすべてのセルが空白かどうかをチェック
        If WorksheetFunction.CountA(Row) = 0 Then
            ' 空白行の場合、その行を rowToDelete に追加
            If rowToDelete Is Nothing Then
                Set rowToDelete = Row
            Else
                Set rowToDelete = Union(rowToDelete, Row)
            End If
        End If
    Next Row
    ' rowToDelete がある場合、その行を削除
    If Not rowToDelete Is Nothing Then
        rowToDelete.Delete
    Else
        MsgBox "空白行が見つかりませんでした。"
    End If
End Sub
' 空白行が見つかった場合、その行全体を rowToDelete に追加し、
' 最後に一括して削除します。使用例は、以下です。
Private Sub 使用例()
    Dim tbl As ListObject
    ' テーブルを取得
    Set tbl = ActiveSheet.ListObjects(1)
    Call TableRowBlankToDelete(tbl)
End Sub引数にテーブルを指定して、サブルーチンを呼び出すと、実行でします。

このテーブルで実行すると、以下のように、行すべてのセルが空白の場合、その行を削除されます。




