Sub Test()
Dim i&, j&, cell As Range
Dim cl&, arr1(), arr2(), x%, y%, z%
i = Cells(Rows.Count, 1).End(xlUp).Row
j = Cells(1, Columns.Count).End(xlToLeft).Column
Set cell = Range(Cells(1, 1), Cells(i, j))
    cell.Sort Key1:=cell(1), order1:=xlAscending, Header:=xlYes
    For cl = j + 1 To cell.Count Step j
        Select Case Right(cell(cl).Value, 1)
            Case 1, 3, 5, 7, 9
                x = x + 1: ReDim Preserve arr1(1 To j, 1 To x)
                    For z = 0 To j - 1
                         arr1(z + 1, x) = cell(cl + z)
                    Next z
        Case 0, 2, 4, 6, 8
                y = y + 1: ReDim Preserve arr2(1 To j, 1 To y)
                    For z = 0 To j - 1
                            arr2(z + 1, y) = cell(cl + z)
                    Next z
      End Select
    Next cl
arr1 = Application.Transpose(arr1): arr2 = Application.Transpose(arr2)
Cells(UBound(arr1, 1) + 2, 1).Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
Cells(2, 1).Resize(UBound(arr1, 1), UBound(arr1, 2)) = arr1
End Sub

Private Sub CommandButton1_Click()
    Dim i As Long, a(), q: Application.ScreenUpdating = False
    a = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    For i = 1 To UBound(a, 1)
        q = Split(a(i, 1))
        If Val(q(UBound(q))) Mod 2 = 0 Then a(i, 1) = "_" & a(i, 1)
    Next
    [A2].Resize(UBound(a, 1)).Value = a
    [A:E].Sort [A1], Header:=xlYes
    [A:A].Replace "_", ""
End Sub