VBA将多列转换为两列-我在做什么错？

Question

Hi I'm not very familiar with vba. But I came up with the following to turn a spreadsheet with multiple columns into just two. Example shows a name with multiple items. I need a row with the name for each item.

You can see the length of each row can change. I do know how many rows. I've made the following script but can't seem to get it to work. Please any advice on how to fix is very helpful!

This is what I have:

name1 | item1 | item2 | item3 | item4

name2 | item5 | item3 | item19

This is what I need:

name1 | item1

name1 | item2

name1 | item3

name1 | item4

name2 | item5

name2 | item3

name2 | item19

Sub moveToRows()
Dim name As String,  item as String,
Dim r As Double, c As Double, r2 As Double, l As Double
Sheets("Sheet1").Select
r = 1
c = 1
r2 = 1
Do While r < 5000
    ActiveSheet.Cells(r, c).Select
    name = ActiveCell.Value
    l = ActiveRow.Length
    Do While c <= l
        item = ActiveCell.Offset(0, c)
        Sheets("Sheet2").Range.Cells(r2, 1).Value = name
        Sheets("Sheet2").Range.Cells(r2, 2).Value = item
        c = c + 1
        r2 = r2 + 1
        Cells(r, c).Select
    Loop
    c = 1
    r = r + 1
Loop

End Sub

Answer 1

I was able to solve the problem with the IsEmpty as suggested. Changed output location as see in variable oRow.

Sub moveToRows()
Dim name As String, item As String
Dim r As Double, oRow As Double
Range("A1").Select
oRow = 5000

For r = 1 To ActiveCell.End(xlDown).Row
    Cells(r, 2).Select
    name = ActiveCell.Offset(0, -1).Value
    If IsEmpty(ActiveCell) Then
        Cells(oRow, 1).Value = name
        oRow = oRow + 1
    End If

    Do Until IsEmpty(Selection)
        item = ActiveCell.Value
        Cells(oRow, 1).Value = name
        Cells(oRow, 2).Value = item
        ActiveCell.Offset(0, 1).Select
        oRow = oRow + 1
        item = ""
    Loop

Next

End Sub

Answer 2

This solution is much faster because:

1. It reads until it finds the first empty cell
2. Doesn't use "Select" which is generally slow

Here you are:

Sub moveToRows()
Dim name As String, item As String

Dim shin As Worksheet
Dim shout As Worksheet

' Edit the sheet names here if needed
Set shin = ActiveWorkbook.Sheets("Sheet1")
Set shout = ActiveWorkbook.Sheets("Sheet2")

Dim r As Double, c As Double, r2 As Double, l As Double

r = 1
r2 = 1

Do
    c = 1
    name = shin.Cells(r, c)
    If name = "" Then Exit Do

    Do
        c = c + 1
        item = shin.Cells(r, c)
        If item = "" Then Exit Do

        shout.Cells(r2, 1).Value = name
        shout.Cells(r2, 2).Value = item

        r2 = r2 + 1
    Loop

    r = r + 1
Loop

End Sub