Private Sub Колонку_справа()
'Вставить колонку справа
'
    If Selection.Range.Information(wdWithInTable) = False Then Exit Sub
    With Selection.Tables(1)
        TblRowsNumber = .Rows.Count
        NewColumnWidth = InputBox$("Введите ширину в мм" & vbCrLf & "для добавления колонки справа", _
                    "Добавить колонку в таблицу", _
                    NewColumnWidth)
        If Val(NewColumnWidth) = 0 Then Exit Sub
        For i = 1 To TblRowsNumber
            LastColNum = .Rows(i).Cells.Count
            .Rows(i).Cells(LastColNum).Select
            Selection.MoveRight
            Selection.InsertCells ShiftCells:=wdInsertCellsShiftRight 'добавляем ячейку
           Selection.Cells.Width = NewColumnWidth 'здесь метит все желтым и добавляется только одна ячейка вместо столбца справа
        Next
    End With
    Selection.MoveDown
End Sub