Макрос для хитрого транспонирования данных

[Доктор]

Добрый день, УВАЖАЕМЫЕ старожилы Форума!
Помогите плз решить проблему:
на листе Вход таблица (умная),
и на листе Маршрут то же таблица (умная).
В таблице на листе Вход данные представлены:
по вертикали - наименования изделий с дополнительными данными;
по горизонтали наименование оборудования, через которое проходит изделие.
На перекрестии слово ДА, это значит, что изделие проходит это оборудование.
Вопрос: как с помощью макроса привести таблицу на листе Вход к виду, указанному в таблице на листе маршрут.

С УВАЖЕНИЕМ,
Док

[ПаВлА]

Может формулами обойтись?

[ПаВлА]

Sub FindYES()
Dim i&, y&, z&, m&, rw&, kl&, kl2&, x As Range
Application.ScreenUpdating = False
With Application.WorksheetFunction
m = .Max(Columns("A:A"))
kl2 = .CountIf(Cells, "ДА")
ReDim t(1 To kl2, 1 To 11)
For i = 1 To m
    rw = Columns("A:A").Find(i, , xlValues, xlWhole).Row
    kl = .CountIf(Rows(rw), "ДА")
    Set x = Rows(rw).Find("ДА", , xlValues, xlWhole)
    For y = 1 To kl
        z = z + 1
        t(z, 1) = Cells(rw, 1)
        t(z, 2) = Cells(rw, 2)
        t(z, 3) = Cells(rw, 3)
        t(z, 4) = Cells(rw, 4)
        t(z, 5) = Cells(rw, 5)
        t(z, 6) = Cells(rw, 6)
        t(z, 7) = Cells(rw, 7)
        t(z, 8) = Cells(rw, 8)
        t(z, 9) = Cells(rw, 9)
        t(z, 10) = Cells(2, x.Column)
        t(z, 11) = "ДА"
        Set x = Rows(rw).FindNext(x)
    Next
Next
[A10:K10] = [{"№","СС","Наименование","Количество","Материал","Прокат","Толщина","Длина","Ширина","Участок","YES"}]
[A11].Resize(kl2, 11) = t
End With
Application.ScreenUpdating = True
End Sub