Code:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim lngStart As Long
Dim lngIndex As Long
Dim lngCount As Long
Dim arrList() As String
Dim oTbl As Table
Dim oRow As Row, oNewRow As Row
lngStart = 1
Set oTbl = ActiveDocument.Tables(1)
Do
On Error GoTo lbl_Exit
Set oRow = oTbl.Rows(lngStart)
lngStart = lngStart + 1
oRow.Select
'Your text in column 2 is a comma separtated list. You can create an array from it
arrList = Split(Left(oRow.Range.Cells(2).Range.Text, _
Len(oRow.Range.Cells(2).Range.Text) - 2), ",")
lngCount = UBound(arrList) + 1
For lngIndex = 1 To lngCount
lngStart = lngStart + 1
If lngIndex <> lngCount Then
oRow.Cells(1).Range.InsertAfter arrList(lngIndex - 1) & vbCr
Else
oRow.Cells(1).Range.InsertAfter arrList(lngIndex - 1)
End If
If lngIndex = 1 Then
Set oNewRow = oTbl.Rows.Add(oRow.Next)
Else
Set oNewRow = oTbl.Rows.Add(oNewRow.Next)
End If
oNewRow.Cells(1).Range.Text = arrList(lngIndex - 1)
Next lngIndex
Loop
lbl_Exit:
Exit Sub
End Sub