Dim myRange As Range
    Dim myTable As Table

    Set myRange = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End)

    Set myTable = ActiveDocument.Tables.Add(Range:=myRange, NumRows:= 1 , NumColumns:= 2 )
    
    myTable.Rows.Height = ActiveDocument.PageSetup.PageHeight -  100 
   
    myTable.Rows.Add BeforeRow:=myTable.Rows( 1 )

ActiveDocument.Tables( 1 ).Cell( 1 ,  2 ).Split NumRows:= 2 

Sub NewTable()
    Dim myRange As Range
    Dim myTable As Table
    Dim newCol As Column

    'Определение позиции курсора
    'Set myRange = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End)
    Set myRange = ActiveDocument.Range(Selection.Range.Start, Selection.Range.Start)
    
    'Добавление таблицы
    Set myTable = ActiveDocument.Tables.Add(Range:=myRange, NumRows:= 1 , NumColumns:= 2 )
    
    'Установка высоты таблицы
    myTable.Rows.Height = ActiveDocument.PageSetup.PageHeight -  100 
    myTable.Rows.HeightRule = wdRowHeightExactly
    
    'Установка ширины первого столбца таблицы
    myTable.Columns( 1 ).Width = InchesToPoints( 0 . 16 )
        
    'Устанавливаем автовыравнивание таблицы - по ширине
    myTable.AutoFitBehavior _
        wdAutoFitWindow
        
    '//////////
    myTable.Cell( 1 ,  1 ).Split NumRows:= 3 
    
    myTable.Cell(Row:= 1 , Column:= 2 ).Split NumRows:= 3 
    
    myTable.Cell(Row:= 1 , Column:= 2 ).Merge _
                MergeTo:=myTable.Cell(Row:= 2 , Column:= 2 )
                
    myTable.Columns( 2 ).Cells( 2 ).Split NumRows:= 2 
    
    myTable.Columns( 2 ).Cells(Index:= 1 ).Merge _
            MergeTo:=myTable.Columns( 2 ).Cells(Index:= 2 )
            
    myTable.Columns( 2 ).Cells( 2 ).Split NumRows:= 7 
    '//////////
    
    
        
    'Устанавливаем рамку вокруг таблицы
    myTable.Borders.OutsideLineStyle = wdLineStyleSingle
    myTable.Borders.OutsideLineWidth = wdLineWidth025pt
    myTable.Borders.InsideLineStyle = wdLineStyleNone
    
    'Убираем выделение
    Selection.Collapse Direction:=wdCollapseEnd
End Sub

Sub AddCell()
ActiveDocument.Tables( 1 ).Columns( 2 ).Cells( 2 ).Split NumColumns:= 3   ':)
'Код ниже не пашет не знаю как обратиться к ячейкам
'ActiveDocument.Tables(1).Columns(2).Cells(4).Split NumColumns:=3  ':)
'ActiveDocument.Tables(1).Columns(2).Cells(6).Split NumColumns:=3  ':)

ActiveDocument.Tables( 1 ).Cell( 1 ,  2 ).Row.Select

End Sub