Sub MailMergeToDoc()
Application.ScreenUpdating = False
Dim Tbl As Table, c As Long, r As Long, StrVal As String
ActiveDocument.MailMerge.Execute
For Each Tbl In ActiveDocument.Tables
  With Tbl
    For r = .Rows.Count To 1 Step -1
      If Len(.Rows(r).Range.Text) = .Rows(r).Cells.Count * 2 + 2 Then
          .Rows(r).Delete
      Else
        For c = 3 To 4
          StrVal = Split(.Cell(r, c).Range.Text, vbCr)(0)
          If InStr(StrVal, "") > 0 Then
            StrVal = Replace(Replace(Replace(StrVal, ".", "|"), ",", "."), "|", ",")
            .Cell(r, c).Range.Text = StrVal
          End If
        Next
      End If
    Next
  End With
Next
Application.ScreenUpdating = True
End Sub