Copy/Cut Non-Empty Rows to the Top Rows

Question

I want to check for a non-empty cell between the range A4:C7.
If there is a value in A6 then copy/cut the range A6:C6 and paste to range A4.
If there a value in A5 & B7 then copy/cut the range A5:C5 & A7:C7 and paste to range A4.

The flaws with the following code

1. It doesn't check for values under B4, B5, B6, B7 or C4, C5, C6, C7.
2. It doesn't work if it detects a value in A4. (I want to overwrite the value.)

Sub CopyNonEmptyRowsToTopRows22()

    Dim rng As Range
    Dim i As Integer
    
    For i = 4 To 7
        If Not IsEmpty(Sheet4.Range("A" & i)) Then
            If rng Is Nothing Then
                Set rng = Sheet4.Range("A" & i & ":C" & i)
            Else
                Set rng = Union(rng, Range("A" & i & ":C" & i))
            End If
        End If
    Next i
    
    rng.Cut Sheet4.Range("A4")
End Sub

Answer 1

Remove Blank (Empty) Rows

Usage

Sub CopyNonEmptyRowsToTopRows22()
    RemoveBlankRows Sheet4.Range("A4:C7")
End Sub

The Method

Sub RemoveBlankRows(ByVal rg As Range)

    Dim srCount As Long: srCount = rg.Rows.Count
    If srCount = 1 Then Exit Sub
    
    Dim cCount As Long: cCount = rg.Columns.Count
    Dim Data() As Variant: Data = rg.Value
    
    Dim sr As Long, dr As Long, c As Long, IsBlankRowFound As Boolean
    
    ' Copy to top.
    For sr = 1 To srCount
        For c = 1 To cCount
            If Len(CStr(Data(sr, c))) > 0 Then Exit For ' non-blank row found
            'If IsEmpty(Data(sr, c)) Then Exit For ' non-empty row found
        Next c
        If c <= cCount Then ' non-blank row found
            dr = dr + 1
            If IsBlankRowFound Then
                For c = 1 To cCount
                    Data(dr, c) = Data(sr, c)
                Next c
            End If
        Else ' blank row found
            IsBlankRowFound = True
        End If
    Next sr
    
    If Not IsBlankRowFound Then Exit Sub ' no blank row found
    
    ' Clear bottom.
    For sr = dr + 1 To srCount
        For c = 1 To cCount
            Data(sr, c) = Empty
        Next c
    Next sr
        
    rg.Value = Data

End Sub

Edit

Initial

First Code or MoveToTop = False (or omitted)

Sub CopyNonEmptyRowsToTopRows22()
    RemoveBlankRows Sheet4.Range("A4:C7"), False
End Sub

Second Code i.e. MoveToTop = True

Sub CopyNonEmptyRowsToTopRows22()
    RemoveBlankRows Sheet4.Range("A4:C7"), True
End Sub

Second Code

Sub RemoveBlankRows( _
        ByVal rg As Range, _
        Optional ByVal MoveToTop As Boolean = False)

    Dim rCount As Long: rCount = rg.Rows.Count
    If rCount = 1 Then Exit Sub
    
    Dim cCount As Long: cCount = rg.Columns.Count
    Dim sData() As Variant: sData = rg.Value
    
    Dim coll As Collection, sr As Long, c As Long
    Dim IsNonBlankRowFound As Boolean, IsBlankRowFound As Boolean
    
    For sr = 1 To rCount
        For c = 1 To cCount
            If Len(CStr(sData(sr, c))) > 0 Then ' non-blank row found
                If Not IsNonBlankRowFound Then
                    IsNonBlankRowFound = True
                    Set coll = New Collection
                End If
                coll.Add sr
                Exit For
            End If
        Next c
        If Not IsBlankRowFound Then
            If c > cCount Then IsBlankRowFound = True
        End If
    Next sr
    
    If Not IsNonBlankRowFound Then Exit Sub ' all rows are blank
    If Not IsBlankRowFound Then ' no blank rows found
        If Not MoveToTop Then Exit Sub
    End If
    
    Dim dData() As Variant: ReDim dData(1 To rCount, 1 To cCount)
    Dim r As Long: r = coll.Count
    
    Dim dr As Long, rStart As Long, rEnd As Long, rStep As Long
    
    If MoveToTop Then
        rStart = r: rEnd = 1: rStep = -1
    Else
        rStart = 1: rEnd = r: rStep = 1
    End If
    
    For r = rStart To rEnd Step rStep
        dr = dr + 1
        sr = coll(r)
        For c = 1 To cCount
            dData(dr, c) = sData(sr, c)
        Next c
    Next r
        
    rg.Value = dData

End Sub