Sub Add_atribute()
    'определяем начало характеристик
    Dim start As Integer
    start = 12
    'определяем последнюю заполненную колонку справа
    Dim lLastCol As Long
    lLastCol = Cells(1, Columns.Count).End(xlToLeft).Column
    'определяем последнюю заполненную строку
    Dim lLastRow As Long
    lLastRow = Cells(Rows.Count, start).End(xlUp).Row
    'вычисляем размерность массива
    Dim w As Integer
    w = lLastCol - start
    Dim b As Variant
    ReDim b(1 To lLastRow, 1 To w * 3)
    'ReDim b(1 To 5, 1 To 6)
    Dim a As Variant
    Dim y As Integer
    'a = Range(Cells(1, 12), Cells(5, 14))
    a = Range(Cells(1, 12), Cells(lLastRow, lLastCol))
    Count = UBound(a, 2) - LBound(a, 2) + 1
    For x = 2 To UBound(b)
    zz = 0
    ii = 0
    p = 1
        For y = 2 To Count
                'записываем шапку
                ii = ii + 1
                b(1, ii) = "Attr. Group " & p
                ii = ii + 1
                b(1, ii) = "Attribute " & p
                ii = ii + 1
                b(1, ii) = "Attribute value " & p
    
                ' записываем категорию
                zz = zz + 1
                b(x, zz) = a(x, 1)
                ' записываем Год
                zz = zz + 1
                b(x, zz) = a(1, y)
                ' записываем value
                zz = zz + 1
                b(x, zz) = a(x, y)
            p = p + 1
        Next y
    Next x
    Sheets("OUT").Cells(1, 1).Resize(UBound(b), UBound(b, 2)) = b
End Sub