Как решить такую задачу макросом?

Question

[Максим Тимофеев]

Вот таблица:
1 а б в конец
2 г д е конец
3 ж з и конец
Вот код макроса:

Sub Tratata()

    Dim row As Long, column As Long, i As Long, k As Long
    row = 1
    column = 1
    k = 0
    Do While Len(Cells(row, column).Value) <> 0
    Sheets("11").Cells(row, column).Copy
    Sheets("22").Cells(k + 1, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Sheets("11").Cells(row, column + 1).Copy
    Sheets("22").Cells(k + 1, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
        i = 2
        k = k + 1
        Do While i < 4
            Sheets("11").Cells(row, 1).Copy
            Sheets("22").Cells(row + k, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=True
            Sheets("11").Cells(row, column + i).Copy
            Sheets("22").Cells(row + k, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=True
            i = i + 1
            k = k + 1
        Loop
        row = row + 1
        Sheets("11").Select
    Loop
    
End Sub

Получаю:
1 а
1 б
1 в
2 г

2 д
3 ж


3 з
3 и
Есть пропуски пропуски и пустые строки ожидаю увидеть это:
1 а
1 б
1 в
2 г
2 д
2 е
3 ж
3 з
3 и
В чем я туплю? Vb знаю 2 часа. Так что не судите строго. Нужда толкнула и таблица в 150000 строк, которую нужно привести в порядок.

Answer 1

[Антон Федорян]

Вот вам неймется :) пока с работы ехал еще вопрос придумали!
Пробуйте это:

Sub Macros()
    Dim i, j, counter As Integer
    
    counter = 1
    i = 1
    While Sheets("Лист1").Cells(i, 1) <> ""
        j = 2
        While Sheets("Лист1").Cells(i, j) <> ""
            Sheets("Лист2").Cells(counter, 1) = Sheets("Лист1").Cells(i, 1) & Sheets("Лист1").Cells(i, j)
            counter = counter + 1
            j = j + 1
        Wend
        i = i + 1
    Wend
End Sub

UpD:

Sub Macros()
    Dim i, j, counter As Integer
    
    counter = 1
    i = 1
    While Sheets("11").Cells(i, 1) <> ""
        j = 2
        While Sheets("11").Cells(i, j) <> "Конец"
            If Sheets("11").Cells(i, j) = "" Then
                j = j + 1
            Else
                Sheets("22").Cells(counter, 1) = Sheets("11").Cells(i, 1)
                Sheets("22").Cells(counter, 2) = Sheets("11").Cells(i, j)
                counter = counter + 1
                j = j + 1
            End If
        Wend
        i = i + 1
    Wend
End Sub

Comments

[Максим Тимофеев]

получаю в первой ячейки значения 2-х "1а", во второй "а", а должно быть в первой "1", во второй "а", но за метод спасибо

[Максим Тимофеев]

Тут еще нюанс в том, что ограничителем строки является ячейка с текстом "конец", при этом могут попадаться пустые ячейки. Их можно тоже использовать, но они не должны прерывать цикл

[Антон Федорян]

Максим Тимофеев: еще раз, что должно быть в результате? каждый символ в своей ячейке или 1а, 1б, 2в и т.д.?

[Максим Тимофеев]

допилил Ваш результат Sub Macrosmax()
Dim i, j, counter As Integer

counter = 1
i = 1
While Sheets("11").Cells(i, 1) <> ""
Sheets("22").Cells(counter, 1) = Sheets("11").Cells(i, 1)
Sheets("22").Cells(counter, 2) = Sheets("11").Cells(i, 2)
counter = counter + 1
j = 3
While Sheets("11").Cells(i, j) <> "конец"
Sheets("22").Cells(counter, 1) = Sheets("11").Cells(i, 1)
Sheets("22").Cells(counter, 2) = Sheets("11").Cells(i, j)
counter = counter + 1
j = j + 1
Wend
i = i + 1
Wend
End Sub

[Максим Тимофеев]

в первой ячейки 1 столбец всегда, во второй 2-й или 3-й в зависимости от цикла

[Антон Федорян]

Максим Тимофеев: чуть подправил код

[Максим Тимофеев]

Спасибки. Я как нео. Теперь я знаю кунг-фу (vba)