Excelシート中の空行・見出し行を削除する

すべての空行と、2つ目以降の見出し行を削除する。
Sub EraseBlankRowAndLeaveFirstHeaderRow()
Application.ScreenUpdating = False

    Dim r As Long, c As Long, d As Long
     '  Margin which include header row
    Dim header_margin As Long:  header_margin = 5
     
     '  String of first cell of header row
      ' ********Change for each sheet**** **
    Dim header_first_cell As String:  header_first_cell = "No"
     '***********************************
     
    Dim Target As Range

    With ActiveSheet.UsedRange
        For r = 1 To .Rows.Count
            
            'check whether each  columns on a row is empty
            For c = 1 To .Columns.Count
                If Not IsEmpty(.Cells(r, c).Value) Then Exit For '---(1)
            Next c
               
             'if all column is empty , add the row to the target
            If c = .Columns.Count + 1 Then
                If Target Is Nothing Then
                    Set Target = .Rows(r).EntireRow
                Else
                    Set Target = Union(Target, .Rows(r).EntireRow)
                End If
            End If
            
             ' Save  first  header row
             If r > header_margin Then
                'if first column is  "No", Remove the row.
                 If Cells(r, 1).Value = header_first_cell Then
                     If Target Is Nothing Then
                        Set Target = .Rows(r).EntireRow
                    Else
                        Set Target = Union(Target, .Rows(r).EntireRow)
                    End If
                End If
            End If

        Next r
    End With
    
    If Not Target Is Nothing Then
        Target.Delete
    End If
    
    Application.ScreenUpdating = True

End Sub
sahara-ooga/remove_no_need_row.md
