Копирование и траспонирование с шагом

[OgE®_M@G]

Здравствуйте УВАЖАЕМЫЕ форумчане. Есть два листа необходимо с первого листа скопировать данные по строчно и траспонировать их (делается это для сравнения с другой таблицей). Макрорекордером записал следующее:

Sub Макрос1()
'Pervaya stroka
    Sheets("Лист1").Select
    Range("A1:AH2").Select 'Начальный диапазон
    Selection.Copy
    Sheets("Лист2").Select
    Range("B1").Select 'Первая ячейка
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("C1").Select 'Первая ячейка
    Application.CutCopyMode = False
    Selection.Cut Destination:=Range("A2") 'Начальный диапазон
    Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:A34"), Type:=xlFillCopy 'Начальный диапазон
    Range("A2:A34").Select 'Начальный диапазон
    Range("A1").Select 'Первая ячейка
    Selection.EntireRow.Delete
'Vtoraya stroka
    Sheets("Лист1").Select
    Range("A3:AH3").Select ' Диапазон меняется циклично +1
    Selection.Copy
    Sheets("Лист2").Select
    Range("C34").Select ' Диапазон меняется циклично +33
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("C34").Select ' Диапазон меняется циклично +33
    Application.CutCopyMode = False
    Selection.Cut Destination:=Range("A35") ' Диапазон меняется циклично +33
    Range("A35").Select
    Selection.AutoFill Destination:=Range("A35:A67"), Type:=xlFillCopy ' Диапазон меняется циклично +33
    Range("A35:A67").Select ' Диапазон меняется циклично +33
    Range("A34").Select ' Диапазон меняется циклично +33
    Selection.EntireRow.Delete
'Tretiya stroka
    Sheets("Лист1").Select
    Range("A4:AH4").Select ' Диапазон меняется циклично +1
    Selection.Copy
    Sheets("Лист2").Select
    Range("C67").Select ' Диапазон меняется циклично +33
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("C67").Select ' Диапазон меняется циклично +33
    Application.CutCopyMode = False
    Selection.Cut Destination:=Range("A68") ' Диапазон меняется циклично +33
    Range("A68").Select ' Диапазон меняется циклично +33
    Selection.AutoFill Destination:=Range("A68:A100"), Type:=xlFillCopy ' Диапазон меняется циклично +33
    Range("A68:A100").Select ' Диапазон меняется циклично +33
    Range("A67").Select ' Диапазон меняется циклично +33
    Selection.EntireRow.Delete
End Sub

Строк очень много и поправлять код вручную тяжело. Можно ли органищовать цикл до последней заполненной строки. Прошу помочь в решении данного вопроса.

[alex77755]

Лучше бы приложил файлы "что есть" и "как надо"

[OgE®_M@G]

Хорошо выложу соответствующие файлы. СПАСИБО.

[OgE®_M@G]

Вот файл:
1. Лист1 данные, которые есть
2. Лист2 так как нужно собрать (полностью все до последней строки. она меняется)
3. Лист3 просто тупо формулами забивал и копировал в макрос. Очень муторно.

[DiemonStar]

Судя по данным, на Листе3 именно то, что вам нужно

[IgorGO]

я тоже тупо написал три формулы на листе2. теперь их так же тупо можно просто копировать вниз по листу.

[OgE®_M@G]

Спасибо большое. То что нужно и без макроса.