merge cells upto blank cells

[Rakesh]

Hi Guys,

I had bunch of client supplied word files, which single paragraph is divided into multiple cells.

Attached file for your reference.

What I right now doing is selecting the cells manually and merge the cells through Menu Bar/Table/Merge Cells and replacing paragraph return with space.


Can it possible to do it by macro?

If so it saves me a day!!!!

Thanks
Rakesh

[gmaxey]

This should get you close:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oTbl As Table, oRow As Row, lngIndex As Long, lngCol As Long
Dim oRng As Range
Set oTbl = ActiveDocument.Tables(1)
Set oRng = oTbl.Rows(1).Range
Do
Do
oRng.MoveEnd wdRow, 1
Loop Until Len(oRng.Rows.Last.Range) = 14
For lngIndex = 2 To oRng.Rows.Count - 1
For lngCol = 1 To 6
oRng.Rows(1).Cells(lngCol).Range.Text = Trim(Left(oRng.Rows(1).Cells(lngCol).Range.Text, _
Len(oRng.Rows(1).Cells(lngCol).Range.Text) - 2) & " " & Left(oRng.Rows(lngIndex).Cells(lngCol).Range.Text, _
Len(oRng.Rows(lngIndex).Cells(lngCol).Range.Text) - 2))
Next lngCol
Next lngIndex
For lngIndex = oRng.Rows.Count - 1 To 2 Step -1
oRng.Rows(lngIndex).Delete
Next lngIndex
On Error GoTo lbl_Exit
Set oRng = oRng.Rows.Last.Next.Range
Loop
lbl_Exit:
Exit Sub

End Sub