Merging across columns or rows

[Angie]

Suppose I highlight several cells in a table, say 3 columns and 2 rows. I would like a macro that merges across the columns or across the rows. Excel does this, but Word does not. Can anyone either help me write it or find it?

 

[Dreamboat]

Versions 2000 and above should do this
Go to View-Toolbars and choose the tables and borders toolbar. You won't need a macro. There's a merge button there. However, consider that each number below is a cell. You cannot merge cells 1 though 7. You can only merge rectangular shapes in a table

1 2
4 5
7 8

 

[Klaus Linke]

Suppose I highlight several cells in a table, say 3 columns
and 2 rows. I would like a macro that merges across the
columns or across the rows. Excel does this, but Word
does not. Can anyone either help me write it or find it?

Hi Angie,

The macro below will merge cells in the selection horizontally. I can't
guarantee that it'll work properly in all cases when there are merged cells
already, but it has worked fine for me when I needed it.
I haven't needed a macro for merging cells "vertically" yet; maybe a macro
along the same lines could be written.
If you don't need it often, and don't have too many cells to merge, you
could try the "eraser" tool from the "tables and borders" toolbar. It does a
pretty good job merging cells in different ways.

Regards,
Klaus


Sub MergeCellsInSelectionHorizontally()
' Select cells, then run the macro
Dim RowStart, RowEnd
ActiveDocument.Bookmarks.Add _
Range:=Selection.Range, _
Name:="SelOld"

Do
With Selection
ActiveDocument.Bookmarks.Add _
Range:=.Range, Name:="Sel"

RowStart = .Cells(1).RowIndex
RowEnd = .Cells(.Cells.Count).RowIndex

' Necessary if whole table is selected:
.GoTo What:=wdGoToBookmark, Name:="Sel"

While .Information(wdEndOfRangeRowNumber) _
<> RowStart
.MoveUp Unit:=wdLine, _
Count:=1, Extend:=wdExtend
Wend
.Cells.Merge
.MoveDown Unit:=wdLine, _
Count:=1, Extend:=wdMove

.End = ActiveDocument.Bookmarks("Sel").End
ActiveDocument.Bookmarks("Sel").Delete
End With
Loop While RowEnd > RowStart

Selection.GoTo What:=wdGoToBookmark, Name:="SelOld"
ActiveDocument.Bookmarks("SelOld").Delete

' Restore Selection:
While Selection.Cells(Selection.Cells.Count).ColumnIndex _

Selection.Cells(1).ColumnIndex

Selection.MoveLeft _
Unit:=wdCharacter, _
Count:=1, _
Extend:=wdExtend
Wend

End Sub