Преобразовать таблицу

[SlimFIT]

Добрый вечер.
Впервые столкнулся с проблемой преобразования таблицы в Excel.
Небходимо транспонировать таблицу (около 1000 записей).

Если бы было мало записей можно редактировать руками, но с 1000 записями это проблематично)))

Максимум что я смог сделать с помощью макросов - дублировать записи, а как грамотно транспонировать запись - не понимаю.((

Может кто-нибудь подсказать как сделать?

[ShAM66]

Если проблема только в транспонировании, то

Sub Макрос1()
    Range("K1:AV3").Copy
    Range("A4").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Application.CutCopyMode = False
End Sub

ЗЫ: Записал макрорекордером.

[SlimFIT]

Чтобы обработать тысячу, две строк необходимо организовать цикл.
Я подумал и написал такой алгоритм:
1 шаг:
Макрос1 - добавляет пустые строки после каждой записи

Sub n()
  RowCount = 100 ' количество строк в таблице
  RouIns = 40 ' количество строк для вставки
  For i = 4 To RowCount
    Range("B" & i + s & ":B" & i + s + RouIns).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    s = s + RouIns + 1
  Next
End Sub

2 шаг: Заполнить пустые строки значениями.
Тут указано как это делать

3шаг:
Макрос2- транспонирование строк

Sub Macros1()

For pos = 3 To 1500 'последняя строка в таблице   
        Sheets("Лист1").Select
        Range("N1", "BC2").Select
        Selection.Copy
        Range("A" & pos).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
                
        Range("N" & pos, "BC" & pos).Select
        Selection.Copy
        Range("C" & pos).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
        pos = pos + 41
    
Next pos
End Sub

Остается только удалить все лишнее и таблица готова.

Код мой конечно не идеален, если кто знает как улучшить его, пожалуйста отпишитесь))