Sub транспонирование_пирамидаAPI()
    Dim sn As Range, i%, j%
    i = 2
    j = 0
    sn = ActiveSheet.Cells(i, 2)
    Do Until sn.Value = ""
        If Not sn.Characters(1, 1).Font.Bold Then
         j = j + 1
         sn.Offset(1, -j).Value = sn.Value
        Else
          j = 0
        End If
        i = i + 1
        sn = ActiveSheet.Cells(i, 2)
    Loop
End Sub