Sub Demo()
Application.ScreenUpdating = False
Dim Tbl As Table, r As Long, i As Long, StrCol1 As String, StrCol2 As String, StrTmp As String
With ActiveDocument.Tables(1)
  For r = 1 To .Rows.Count
    If Len(.Cell(r, 1).Range.Text) > 2 Then
      StrTmp = ""
      StrCol1 = Split(.Cell(r, 1).Range.Text, vbCr)(0)
      StrCol2 = Split(.Cell(r, 2).Range.Text, vbCr)(0)
      For i = 0 To UBound(Split(StrCol1, Chr(11)))
        StrTmp = StrTmp & Split(StrCol1, Chr(11))(i) & " " & Split(StrCol2, Chr(11))(i) & Chr(11)
      Next
      StrTmp = Left(StrTmp, Len(StrTmp) - 1)
      .Cell(r, 1).Range.Text = StrTmp
    End If
  Next
  .Columns(2).Delete
End With
Application.ScreenUpdating = True
End Sub