Option Explicit

Sub MoveToASingleColumn()


    Dim ws1     As Worksheet
    Dim ws2     As Worksheet
    Dim arr()   As Variant
    
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    
    Dim x   As Long
    Dim y   As Long
    Dim i   As Long
    
    x = ws1.Range("A" & Rows.Count).End(xlUp).Row
    y = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
    
    arr = Cells(1, 1).Resize(x, y).Value
    
    i = 1
    For x = LBound(arr, 1) To UBound(arr, 1)
        For y = LBound(arr, 2) To UBound(arr, 2)
            If Len(arr(x, y)) <> 0 Then
                ws2.Cells(i, 1).Value = arr(x, y)
                i = i + 1
            End If
        Next y
    Next x
    
    Erase arr
    
    Set ws1 = Nothing
    Set ws2 = Nothing
    
End Sub