Распределить данные из столбца таблицы

[Be_honest_1]

Добрый день!
Помогите, пожалуйста, исправить код макроса. Пример входных данных и мои попытки реализации во вложении.

Вопрос в следующем:
Есть таблица из 1 столбца, входная информация хранится в столбце [А] (см. рисунок 111.jpg ).
Допустимые форматы информации таблицы:
(1) Численные значения, "обрамляющие" по строкам информацию формата (2) и (3)
(2) Тестовая информация произвольного содержания, как правило (но не всегда), содержащая знак "?".
(3) Текстовая информация произвольного содержания,
Примечание:строки формата (2) и (3) всегда находятся как бы блоками МЕЖДУ СТРОКАМИ с численными значениями.

Необходимо распределить информацию на 3 столбца - (1), (2), (3) по правилу, показанному на рисунке 111.jpg (столбцы [C]-[E])
Прикрепила 2 рисунка.
Первый - пример входных данных и то, что должно получиться в идеале. Цвета, расположение на листе абсолютно непринципиально. Это не лабораторка. Данные выгружаются из приложения только в таком формате и только вот так криво, возможности выгрузить по-другому нет Поскольку в строках формата (2) и (3) может быть текстовая информация произвольного характера, единственным отличительным знаком между строками формата (2) и (3) может служить знак "?". Это можно использовать как дополнительное условие проверки.
Даже если где-то строки формата (2) и (3) распределятся НЕВЕРНО между собой, это не так страшно. Перенесу вручную. Самое главное - чтобы строки, стоящие в одном блоке между соседними цифрами из (1) не перепрыгивали в строки, стоящие для следующего блока строк
Второй рисунок - мой горе-результат

Помогите, пожалуйста, навести порядок в распределении данных, если это возможно. Буду рада любому варианту, который улучшит мои попытки

Спасибо.

[IgorGO]

при активном листе с данными выполните этот

Sub DataPrepare()
  Dim r1 As Long, r(5) As Long, c As Long
  c = 3:  r(3) = 1: r(4) = 1: r(5) = 1:  If Cells(1, 1) = "" Then r1 = Cells(1, 1).End(xlDown).Row Else r1 = 1
  Do
    Cells(r(c), c) = Cells(r1, 1): r(c) = r(c) + 1
    If Cells(r1 + 1, 1) = "" And Cells(r1 + 1, 1).End(xlDown).Row = Rows.Count Then Exit Sub
    Do: r1 = r1 + 1: Loop Until Cells(r1, 1) <> ""
    If IsNumeric(Cells(r1, 1)) Then r(3) = Application.Max(r(3), r(4), r(5)): c = 3: r(4) = r(3): r(5) = r(3) Else If c < 5 Then c = c + 1
  Loop Until False
End Sub