Необходимо сделать из списка таблицу

[Azz100]

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

p.s. Белый господин! Не дай пропасть. Помогите решить эту задачку.

[SAS888]

Например, так:

Sub Main()
    Dim x As Range, fst As String: Application.ScreenUpdating = False
    Sheets(2).Rows("2:" & Rows.Count).ClearContents
    Sheets(1).Activate: Set x = [A:A].Find(what:="[uid]", LookAt:=xlWhole)
    If Not x Is Nothing Then
        fst = x.Address
        Do
            x.Offset(, 1).Resize(4, 1).Copy
            Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
            Set x = [A:A].FindNext(x)
        Loop While fst <> x.Address
    End If
    Sheets(2).[A:D].Sort Key1:=Sheets(2).[A1], Order1:=xlAscending, Header:=xlYes
End Sub

Пример во вложении. Запустите макрос "Main".

[Azz100]

SAS888
Спасибо тебе, о Белый Господин! Теперь негр сможет продолжить работу. Все работает правильно.