I'm trying to delete columns from a table which has horizontally merged cells
Selection.MoveEnd Unit:=WdUnits.wdCell, Count:=3
Selection.Columns.Delete
Eventhough columns are getting deleted, merged cells are removed in the process leaving a broken table.
Almost similar approach to delete rows works fine as explained in this answer
Workaround
I'm doing something like this as work around
Selection.MoveEnd Unit:=WdUnits.wdCell, Count:=3
Selection.MoveDown Unit:=WdUnits.wdLine, Count:=2, Extend:=wdExtend
Selection.Cells.Delete
Then setting width of Cell at index 1,2 to rest of the table rows. This way you can avoid merged cell getting deleted.
Word tables are not always intuitive. If a cell spans a column that is to be deleted, then the ENTIRE spanned cell will always be deleted, as you have shown.
When I'm NOT using VBA, I always unmerge cells before deleting rows or columns; otherwise Word's behavior is hard to predict.
Using VBA I would suggest the following:
'splits the header row of the current table into 7 cells
Selection.tables(1).cell(1,2).split numrows:=1, numcolumns:=7
'your code to delete columns
Selection.MoveEnd Unit:=WdUnits.wdCell, Count:=3
Selection.Columns.Delete
'merge the header row back into one span
ActiveDocument.Range( _
start:= Selection.tables(1).cell(1,2).range.start, _
end := Selection.tables(1).cell(1,5).range.end _
).cells.Merge
or for a more general approach, to delete n columns:
width = Selection.tables(1).columns.count - 1
Selection.tables(1).cell(1,2).split numrows:=1, _
numcolumns:= width - 1
Selection.MoveEnd Unit:=WdUnits.wdCell, Count:= n
Selection.Columns.Delete
ActiveDocument.Range( _
start:= Selection.tables(1).cell(1,2).range.start, _
end := Selection.tables(1).cell(1,width-n-1).range.end _
).cells.Merge
This should do it
Sub DeleteCols()
Dim Col2Delete As Range
Set Col2Delete = Selection.EntireColumn
Col2Delete.Delete
End Sub