need help!! sort multiple rows into single column

Assuming header starts from A1 and no blank row(s)/column(s) in data range.

Sub test()
    Dim a, b, i As Long, ii As Long, n As Long
    With Cells(1).CurrentRegion
        a = .Value
        ReDim b(1 To Application.CountA(.Offset(1, 1)), 1 To 2)
        For i = 2 To UBound(a, 1)
            For ii = 2 To UBound(a, 2)
                If a(i, ii) <> "" Then
                    n = n + 1
                    b(n, 1) = a(i, 1): b(n, 2) = a(i, ii)
                End If
            Next
        Next
        With .Offset(, .Columns.Count + 2).Resize(n, 2)
            .Value = b
            .Sort .Cells(1, 2), 1, , .Cells(1, 1), 1
        End With
    End With
End Sub