Добрый день, друзья.
Помогите, пожалуйста, найти ошибку.
Есть макрос, который из большой таблицы берет строки по выделению, некоторые столбцы, и вставляет новую таблицу на другой лист. Здесь вроде все работает.
следующим этапом нужно новую таблицу вставить в документ Word, но почему-то вставляется только первый столбец. А иногда вообще возникает ошибка Run-time error '424' Object required
Помогите, пожалуйста, найти ошибку.
Есть макрос, который из большой таблицы берет строки по выделению, некоторые столбцы, и вставляет новую таблицу на другой лист. Здесь вроде все работает.
следующим этапом нужно новую таблицу вставить в документ Word, но почему-то вставляется только первый столбец. А иногда вообще возникает ошибка Run-time error '424' Object required
| Код |
|---|
Sub Макрос11()
'
' Макрос11 Макрос
'
Application.ScreenUpdating = False ' отключаем обновление экрана
If TypeName(Selection) <> "Range" Then _
MsgBox "Выделите диапазон": Exit Sub
Dim sOM As String, FolderName As String, FName As String
Dim WordApp As Object
Dim i1 As Long, i2 As Long, rRange As Range, rRange1 As Range, rRange2 As Range, rRange3 As Range, rRange4 As Range
Dim iLastDog1 As Long
sOM = "\\serv-x\Users$\shustov\Мои документы\ТЗ_шаблон.docx" 'задаем адрес для шаблона документа в word
i1 = Selection.Cells(1).Row
i2 = Selection.Cells(Selection.Cells.Count).Row
Set rRange = Range(Cells(i1, 3), Cells(i2, 3))
rRange.Copy
Worksheets("Лист3").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Set rRange1 = Range(Cells(i1, 5), Cells(i2, 5))
rRange1.Copy
Worksheets("Лист3").Range("b1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Set rRange2 = Range(Cells(i1, 4), Cells(i2, 4))
rRange2.Copy
Worksheets("Лист3").Range("c1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Set rRange3 = Range(Cells(i1, 8), Cells(i2, 8))
rRange3.Copy
Worksheets("Лист3").Range("d1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Set rRange4 = Range(Cells(i1, 7), Cells(i2, 7))
rRange4.Copy
Worksheets("Лист3").Range("e1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
iLastDog1 = Sheets("Лист3").Cells(Sheets("Лист3").Rows.Count, 5).End(xlUp).Row 'вычисляем последнюю строку
Worksheets("Лист3").Range(Sheets("Лист3").Cells(1, 1), Sheets("Лист3").Cells(i2 - i1 + 1, 5)).Copy
On Error Resume Next
Set WordApp = GetObject(, "word.application")
If WordApp Is Nothing Then
Set WordApp = CreateObject("word.application")
End If
On Error GoTo 0
With WordApp
.Visible = True
.Documents.Open Filename:=sOM
Set WordApp = .ActiveDocument
End With
WordApp.Bookmarks("Table").Range.PasteAppendTable
End Sub
|
