Добавление столбца

Sub AddColumn()
Dim oDoc As Document
Dim oTable As Table
Dim oTables As Table
Dim iRows As Integer
On Error Resume Next
Set oDoc = ActiveDocument
Set oTable = oDoc.Tables(1)
iRows = oTable.Columns(1).Cells.Count
For i = iRows To 2 Step -1
    oTable.Columns(1).Cells(i).Select
    Selection.SplitTable
Next i
    For Each oTables In oDoc.Tables
        oTables.Cell(1, 1).Select
        Selection.InsertColumnsRight
        Selection.Cells.Merge
    Next oTables
    Selection.HomeKey Unit:=wdStory
With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Wrap = wdFindContinue
    .Forward = True
    .Text = Chr(13)
    Do While .Execute = True
        iChar = ActiveDocument.Characters.Count - 1
        If oDoc.Range(1, Selection.End).Characters.Count = 1 Or oDoc.Range(1, Selection.End).Characters.Count = iChar Then GoTo NextChar
        If Selection.Previous.Characters(1).Information(wdWithInTable) And _
        Not Selection.Characters(1).Information(wdWithInTable) And _
        Selection.Next.Characters(1).Information(wdWithInTable) Then
        Selection.Characters(1).Delete
        End If
NextChar:
    Loop
End With
End Sub