' ZVI:2012-02-17 Из Excel в Word http://www.planetaexcel.ru/forum.php?thread_id=2813&page_forum=2
' На сообщение от 13.09.2008, 23:44 Скопировать выделенный фрагмент в Word
Sub SelectionToDoc()

  Dim objWord As Object, i As Integer
    Set RB = Sheets("рабочий")  ' это мои (не авторские) строчки
    'Set L2 = Sheets("Лист2")   ' это мои (не авторские) строчки
  Const wdCollapseEnd = 0, wdCharacter = 1, wdNewBlankDocument = 0

  ' Найти открытое приложение Word (это может быть и Outlook, если в нем Word в качестве редактора)
  On Error Resume Next
  Set objWord = GetObject(, "Word.Application")

  ' Если Word-приложение не найдено, то создать новое
  If Err Then
    Set objWord = CreateObject("Word.Application")
  End If
  objWord.Visible = True

  ' При ошибке - на выход! :-)
  On Error GoTo exit_

  ' Если нет ни одного открытого Word-документа, то добавить новый
  If objWord.Documents.Count = 0 Then objWord.Documents.Add
   ' For i = 2 To 100  ' это мои (не авторские) строчки
   ' RB.Cells(28, 1) = L2.Cells(i, 1)  ' это мои (не авторские) строчки
  ' Перейти в конец Word-документа  ' это мои (не авторские) строчки
  With objWord.ActiveDocument.Content
    .Characters(.Characters.Count).Select
  End With

  ' Добавть новый абзац в Word
  objWord.Selection.TypeParagraph

  ' Cкопировать выделенный в Excel диапазон, вместо Selection можно указать и конкретный диапазон,
  ' например: Range("A3:B7").Copy   / для закупок у единого источника Range("A2:R44").Copy
  'Selection.Copy
  Sheets("рабочий").Select  ' это мои (не авторские) строчки
    Range("A2:R44").Copy  ' это мои (не авторские) строчки
  ' Чтобы копировать как рисунок, раскомментировать строку ниже
  'Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

  ' Вставить в Word
  objWord.Selection.Paste

  ' Снять в Excel режим копирования
  Application.CutCopyMode = False

  ' Активировать окно Microsoft Word (закомментировать строку ниже, если не нужно)
  'objWord.Tasks("Microsoft Word").Activate
  'Next i  ' это мои (не авторские) строчки

exit_:

  ' Освободить память, использованную обхектной (As Object) переменной
  Set objWord = Nothing

  ' Сообщить об ошибке, если случится
  If Err Then MsgBox Err.Description, vbCritical, "Ошибка в макросе SelectionToDoc"

End Sub