How to solve this problem with a macro?

Question

Macros

Here is the table:
1 a b c end
2 d e f end
3 f g h i end
Here is the macro code:

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

I get:
1 a
1 b
1 c
2 d
2 e
3 f
3 g
3 and
There are gaps gaps and blank lines I expect to see this:
1 a
1 b
1 c
2 d
2 e
2 f
3 f
3 g
3 and
What am I stupid about ? Vb know 2 hours. So do not judge strictly. Necessity pushed and a table of 150,000 lines, which needs to be put in order.

Answer 1

Here you are itching :) while driving home from work another question came up!
Try this:

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