Cells.WrapText = True

Sub Автоматический_перенос_текста()
Dim a
Dim s As String
Dim s2 As String
Dim t As Boolean
Dim i As Integer
Dim j As Integer
Dim ls As Integer
Dim ch As Range
Dim kol_simvolov_v_stroke As Integer


For Each ch In Selection
  If ch.Value <> "" Then
   kol_simvolov_v_stroke = Round(ch.ColumnWidth)
   If kol_simvolov_v_stroke > ch.ColumnWidth Then
    kol_simvolov_v_stroke = kol_simvolov_v_stroke - 1
   End If
   
   a = Split(ch.Value, Chr(10))
   
   s = ""
   For i = LBound(a) To UBound(a)
    s = s & a(i) & " "
   Next i
   
   ls = Len(s)
   If ls > 1 Then
    ls = ls - 1
    s = Left(s, ls)
   End If
   
   s2 = ""
   
   While Len(s) > 0
     t = False
     For j = kol_simvolov_v_stroke To 1 Step -1
      If Mid(s, j, 1) = " " Then
       s2 = s2 & Left(s, j - 1) & Chr(10)
       s = Mid(s, j + 1)
       t = True
       Exit For
      End If
      
     Next j
     
     If Not t Then
      s2 = s2 & Left(s, kol_simvolov_v_stroke) & Chr(10)
      s = Mid(s, kol_simvolov_v_stroke + 1)
     End If
     
   Wend
   
   ch.Value = Left(s2, Len(s2) - 1)
   
  End If
  
Next ch

End Sub

Sub qqq()
    Set wa = GetObject(, "Word.Application")
    Set wd = wa.activedocument
    With wd.Tables(1)
        .Cell(1, 1) = Cells(3, 1).Value
        .Cell(2, 2) = Cells(4, 2).Value
    End With
End Sub

Sub qq()
'    Set wa = GetObject(, "Word.Application")
    Set wa = CreateObject("Word.Application")
    wa.Visible = True
    Set wd = wa.Documents.Add ' указать шаблон
    Range("A1:B5").Copy
    wa.Selection.Paste
    wd.Tables(1).Select
    wa.Selection.Rows.HeightRule = 0
End Sub

'    Set wa = GetObject(, "Word.Application")