Sub x()
    Dim rInp As Range
    Dim iInp As Long
    Dim iOut As Long
    
    Set rInp = Range("A4", Range("A4").End(xlDown)).Resize(, 10)
    
    For iInp = 1 To rInp.Count
        If Not IsEmpty(rInp(iInp).Value) Then
            iOut = iOut + 1
            rInp(iOut).Value = rInp(iInp).Value
            If iInp <> iOut Then rInp(iInp).ClearContents
        End If
    Next iInp
End Sub
(Rearranges in place.)