Макрос сначала такой: 
Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend  
      Selection.MoveRight Unit:=wdCharacter, Count:=5, Extend:=wdExtend  
      Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend  
      Selection.MoveRight Unit:=wdCharacter, Count:=4, Extend:=wdExtend  
      If ActiveWindow.View.SplitSpecial <> wdPaneNone Then  
          ActiveWindow.Panes(2).Close  
      End If  
      If ActiveWindow.ActivePane.View.Type <> wdPrintView Then  
          ActiveWindow.ActivePane.View.Type = wdPrintView  
      End If  
      ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _  
          InsertBreak Type:=wdSectionBreakContinuous  
      Selection.Start = Selection.Start + 1  
      ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _  
           Type:=wdSectionBreakContinuous  
      With Selection.PageSetup.TextColumns  
          .SetCount NumColumns:=2  
          .EvenlySpaced = True  
          .LineBetween = False  
          .Width = CentimetersToPoints(7.62)  
          .Spacing = CentimetersToPoints(1.25)  
      End With  
      Selection.MoveRight Unit:=wdCharacter, Count:=2  
    
      Selection.EscapeKey  
  End Sub  
  Sub Макрос1()  
  '  
  Потом такой  
  ' Макрос1 Макрос  
  '  
  '  
      If ActiveWindow.View.SplitSpecial <> wdPaneNone Then  
          ActiveWindow.Panes(2).Close  
      End If  
      If ActiveWindow.ActivePane.View.Type <> wdPrintView Then  
          ActiveWindow.ActivePane.View.Type = wdPrintView  
      End If  
      With ActiveDocument.Range(Start:=Selection.Start, End:=ActiveDocument. _  
          Content.End).PageSetup.TextColumns  
          .SetCount NumColumns:=1  
          .EvenlySpaced = True  
          .LineBetween = False  
          .Width = CentimetersToPoints(16.5)  
      End With  
      Selection.TypeText Text:="Текст"  
  End Sub

* Встаём в нужное место и делаем раздел до конца документа
lnStart = THIS.word.Selection.Start
THIS.Word.ActiveDocument.Range(m.lnStart, m.lnStart).InsertBreak(3)

* Делаем колонки (pNCol штук шириной pWidth и расстоянием между ними pSpace)
lnStart = THIS.word.Selection.Start+1
lnEnd   = THIS.word.ActiveDocument.Content.End  
       
WITH THIS.Word.ActiveDocument.Range(m.lnStart, m.lnEnd)
  WITH .PageSetup.TextColumns
    .SetCount(pNCol) && NumColumns:=2
    .EvenlySpaced = -1 && True

    IF pNCol>1
     .LineBetween = 0 && False
     .Width = pWidth*28.22222 && CentimetersToPoints(7.62)
     .Spacing = pSpace*28.22222 && CentimetersToPoints(1.25)
    ENDI
  ENDW     
ENDW