Pasting Excel table to Word, Error on past line "Error 4605"

VikP

New Member
Joined
Mar 29, 2013
Messages
12
Hi
I'm pretty new to VBA and I am trying to do something new in it, a recipe for disaster.
First off, I am using Excel 2010 and windows 7 64-bit.
I am trying to copy an excel table into a word doc. This table changes sizes depending on user inputs and won't always fit on one page of a word doc. Because of this I have multiple copy and past lines. The program works in break mode, stepping through it, but it errors out when I run it. The line of code causing the error is

objDoc.Selection.PasteExcelTable False, False, True

The error I get is :oops: "Run-time error '4605': This method or property is not available because the current selection is at the end of a table row"
I looked online but couldn't find information on this error that seemed to match my problem.

The line of code works in some parts of my code but causes errors in others.
I have tried using

Code:
on error goto 
            err.clear
            Resume

which gives an infinite loop as the error doesn't resolve
I have also tried pausing the execution of the program before the line thinking that word needed time to catch up but that didn't do anything.

Here is the table I am working with
Excel 2010
BCDEFGHIJ
2Home Comparison Report
3
4Loan Details
5Amortization55555555
6Interest Rate2.95%2.95%2.95%2.95%2.95%2.95%2.95%2.95%
7Monthly Payments per Year1212121212121212
8Realtor Fees3.75%3.75%3.75%3.75%3.75%3.75%3.75%3.75%
9GST5.00%5.00%5.00%5.00%5.00%5.00%5.00%5.00%
10Down Payment$22,238.13$22,238.13$22,238.13$22,238.13$22,238.13$22,238.13$22,238.13$22,238.13
11
12Address402 2nd Ave, Beaver Mines698 Lacombe St, Pincher Creek717 Schofield St, Pincher Creek707 Schofield St, Pincher Creek891 Dundas St, Pincher Creek16 Castleview Ridge Estates718 McDougall St, Pincher Creek1109 Hewetson Ave, Pincher Creek
13List Price$425,000.00$199,900.00$199,900.00$254,900.00$318,900.00$254,000.00$179,900.00$169,900.00
14Realtor Fees$15,937.50$7,496.25$7,496.25$9,558.75$11,958.75$9,525.00$6,746.25$6,371.25
15Legal Fees$3,825.00$1,399.30$1,199.40$1,784.30$2,551.20$1,778.00$1,079.40$1,359.20
16Total Price$444,762.50$208,795.55$208,595.65$266,243.05$333,409.95$265,303.00$187,725.65$177,630.45
17
18Loan Amount$444,762.50$196,997.20$196,787.31$257,317.08$327,842.32$256,330.03$174,873.81$164,273.85
19Reccuring Loan Payment$7,981.92$3,535.41$3,531.64$4,617.94$5,883.62$4,600.22$3,138.37$2,948.14
20Monthly Portion of Property Tax$495.83$166.58$199.90$254.90$345.48$338.67$149.92$169.90
21Monthly Mortgage Insurance$798.19$247.48$317.85$369.43$470.69$460.02$219.69$235.85
22Total Monthly Mortgage Payment$9,275.95$3,949.47$4,049.39$5,242.27$6,699.78$5,398.91$3,507.97$3,353.89
23
24
25Total Cost of Ownership in 1st Year$133,549.49$69,631.74$70,830.77$85,145.37$102,635.48$87,025.05$64,333.79$62,484.78
26Present Value of all Ownership Costs$516,867.20$220,069.24$225,636.84$292,105.79$373,320.00$300,833.95$195,468.52$186,882.79

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Report




I've included the entire sub with the problem lines noted. Please don't judge me for my poor coding.
I appreciate any help.

Option Explicit

Sub CreateWordDoc1()
'<<<<the microsoft="" word="" object="" library="" must="" be="" selected="" in="" the="" references.="">>>>></the>

Dim objDoc As Object, i As Integer, columnCount As Integer, j As Integer
Dim wrdDoc As Object


****Set objDoc = CreateObject("Word.Application")
******************objDoc.Visible = True
****Set wrdDoc = objDoc.documents.Add
****
****If objDoc.Selection.PageSetup.Orientation = wdOrientPortrait Then
********objDoc.Selection.PageSetup.Orientation = wdOrientLandscape
****Else
********objDoc.Selection.PageSetup.Orientation = wdOrientPortrait
****End If
******************
****objDoc.Selection.TypeText Text:=wsCalculations.Range("B2").Value

********With objDoc
************.Selection.MoveLeft Unit:=wdCharacter, Count:=24, Extend:=wdExtend
************.Selection.MoveRight Unit:=wdCharacter, Count:=1
********End With
********
****objDoc.Selection.TypeParagraph
****objDoc.Selection.TypeText Text:="Loan Details"
****With objDoc
********.Selection.MoveLeft Unit:=wdCharacter, Count:=12, Extend:=wdExtend
********.Selection.MoveRight Unit:=wdCharacter, Count:=1
****End With
****
****objDoc.Selection.TypeParagraph
****
****With wsCalculations
********columnCount = .Range(.Range("B5"), .Range("B5").End(xlToRight)).Columns.Count - 1
********
********j = 1
********If columnCount > 4 Then
************Do While columnCount > 4
****************
****************'Grab the data headings
****************With .Range("B5")
********************Range(.Offset(0), .End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown)).Copy
****************End With
****************
****************objDoc.Selection.PasteExcelTable False, False, True
****************Application.CutCopyMode = False
****************
****************'reposition the cursor
****************With objDoc
********************.Selection.MoveUp Unit:=wdLine, Count:=22
********************.Selection.MoveRight Unit:=wdCharacter, Count:=13
****************End With
****************
****************'this will clear the undo cache in word which will stop these actions from
****************'being reversed by a user
****************wrdDoc.UndoClear
**************
****************With .Range("B5")
********************Range(.Offset(0, j), .Offset(0, j).End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown).Offset(0, 3)).Copy
****************End With
****************
****************Call WaitPeriod
****************'On Error GoTo Paste_Error
****************
'<<<<<<<<< The code errors out on the next line in run mode but it steps through fine in break mode >>>>
****************objDoc.Selection.PasteExcelTable False, False, True
****************
****************Application.CutCopyMode = False
****************
****************'On Error GoTo 0
**************
****************objDoc.Selection.MoveDown Unit:=wdLine, Count:=23
****************objDoc.Selection.InsertBreak Type:=wdPageBreak
****************objDoc.Selection.TypeText Text:="Loan Details"
****************
****************objDoc.Selection.TypeParagraph
****************
****************j = j + 4
****************columnCount = columnCount - 4
****************wrdDoc.UndoClear
************Loop
************
********
********** If columnCount = 1 Then
****************'Grab the rest of the data headings
****************With .Range("B5")
********************Range(.Offset(0), .End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown)).Copy
****************End With
**************
****************objDoc.Selection.PasteExcelTable False, False, True
****************Application.CutCopyMode = False
****************
****************'Format table and reposition the cursor
****************With objDoc
********************.Selection.MoveUp Unit:=wdLine, Count:=22
********************.Selection.MoveRight Unit:=wdCharacter, Count:=1
********************.Selection.MoveUp Unit:=wdLine, Count:=1
********************.Selection.MoveRight Unit:=wdCharacter, Count:=13
****************End With
****************
****************wrdDoc.UndoClear
****************
****************'Grab the rest of the data
****************With .Range("B5")
********************Range(.Offset(0, j), .Offset(0, j).End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown)).Copy
****************End With
****************
************Else
****************'Grab the rest of the data headings
****************With .Range("B5")
********************Range(.Offset(0), .End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown)).Copy
****************End With
**************
****************objDoc.Selection.PasteExcelTable False, False, True
****************Application.CutCopyMode = False
**************
************
****************'reposition the cursor
****************With objDoc
********************.Selection.MoveUp Unit:=wdLine, Count:=22
********************.Selection.MoveRight Unit:=wdCharacter, Count:=13
****************End With
************
****************wrdDoc.UndoClear
****************
****************With .Range("B5")
********************Range(.Offset(0, j), .Offset(0, j).End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown).End(xlToRight)).Copy
****************End With
****************
************End If
************
************Call WaitPeriod
************'On Error GoTo Paste_Error
************
'<<<<<<<<< The code errors out on the next line in run mode but it steps through fine in break mode >>>>
************objDoc.Selection.PasteExcelTable False, False, True
************
************Application.CutCopyMode = False
************'On Error GoTo 0
************
********Else
************With .Range("B5")
****************Range(.Offset(0), .End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown)).Copy
************End With
**********
************objDoc.Selection.PasteExcelTable False, False, True
************Application.CutCopyMode = False
**********
************
************'reposition the cursor
****************With objDoc
********************.Selection.MoveUp Unit:=wdLine, Count:=22
********************.Selection.MoveUp Unit:=wdLine, Count:=1
********************.Selection.MoveRight Unit:=wdCharacter, Count:=13
****************End With
************
************wrdDoc.UndoClear
************
************'Put the comparison details in the Word Doc
************.Range(.Range("B5"), .Range("B5").End(xlDown).Offset(2).End(xlDown).Offset(2).End(xlDown).Offset(3).End(xlDown).End(xlToRight)).Copy

********** Call WaitPeriod
********** 'On Error GoTo Paste_Error
************objDoc.Selection.PasteExcelTable False, False, True
************Application.CutCopyMode = False
************'On Error GoTo 0
************
********End If
****End With
****
****
****On Error GoTo Error_Handler
****'this will handle the case where the user wants to save multiple reports
****'or runs two in a row with out deleteing one
****i = 0
****objDoc.ActiveDocument.SaveAs ThisWorkbook.Path & "/" & "Home Comparison Report.docx"
****
****wrdDoc.UndoClear
****Application.CutCopyMode = False
****
****
****Exit Sub
Error_Handler:
****If Err <> 0 Then
****i = i + 1
********objDoc.ActiveDocument.SaveAs ThisWorkbook.Path & "/" & "Home Comparison Report " & i & ".docx"
********'objDoc.documents.Close
****End If
****
Paste_Error:
****'tried to ignore the error
****'Wait Period
****'Err.Clear
****'Resume

End Sub


Sub WaitPeriod()
**** 'Tried slowing down the execution of the command but the error still happens
****Application.Wait Now + TimeValue("00:00:01")
End Sub


I'm sorry it's so long, but I thought it might help someone to help me.
Thank you in advance
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,776
Maybe objDoc.Content.InsertAfter.PasteExcelTable False, False, True Or maybe you need to use the With/End With to paste? I think the selection referred to is actually the Word doc selection (you're pasting a table in a table error) not your copying selection. Untested code suggestion. HTH. Dave
 

VikP

New Member
Joined
Mar 29, 2013
Messages
12
Hi Dave. Thanks for responding
I tried .Content.InsertAfter.PasteExcelTable False, False, True and got error 438 object doesn't support
I also tried
.Selection.PasteExcelTable False, False, True 'error 4605
.Selection.Paste 'error 4605
.Selection.PasteExcelTable False, False, True 'error 4605
.Selection.PasteSpecial Link:=False, DataType:=wdPasteRTF, _
Placement:=wdInLine, DisplayAsIcon:=False 'error 4605

Have I structured something wrong?
 

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,776
This will give you some code ideas. It will paste the whole table as a picture in the Word doc. Change the "Test" file address to suit.
Code:
Sub SaveXlRangeToWordFile()
    Dim Wdapp2 As Object, ObjPic As Object
   'open file
    On Error GoTo ErFix
    Set Wdapp2 = CreateObject("Word.Application")
    Wdapp2.ChangeFileOpenDirectory "C:\Test" 'change to suit
    Wdapp2.Documents.Open FileName:="Test.doc" 'change to suit
    Wdapp2.ActiveDocument.Content.PasteSpecial DataType:=3 '9  '4
    'pictures in newxl version are converted to inlineshapes
    'takes time to paste and convert
    Application.Wait (Now + TimeValue("0:00:02"))
    For Each ObjPic In Wdapp2.ActiveDocument.InlineShapes
    ObjPic.ConvertToShape
    Next ObjPic
    'name pic
    'Wdapp2.ActiveDocument.Shapes(1).Name = "XLRange"
    Wdapp2.ActiveDocument.Close savechanges:=True
    Wdapp2.Quit
    Set Wdapp2 = Nothing
    Application.CutCopyMode = False
    Exit Sub

ErFix:
    On Error GoTo 0
    MsgBox "Save to file error."
    Set ObjPic = Nothing
    Wdapp2.ActiveDocument.Close savechanges:=False
    Wdapp2.Quit
    Set Wdapp2 = Nothing
    Application.CutCopyMode = False
End Sub
To use it....
Code:
Dim Objtargetrange As Range
With Sheets("Sheet1")
    Set Objtargetrange = .Range(.Cells(2, "B"), .Cells(26, "E"))
End With
Objtargetrange.Copy
Call SaveXlRangeToWordFile
HTH. Dave
 
Last edited:

VikP

New Member
Joined
Mar 29, 2013
Messages
12
Thanks for the code ideas Dave. I will probably use that in the future.
I was able to find a work around for my problem. Instead of trying to splice the table together in word I ended up doing to on a temporary worksheet and then transferring the completed table over. No more error.
 

NdNoviceHlp

Well-known Member
Joined
Nov 9, 2002
Messages
2,776
Happy to hear that you resolved your problem. Thanks for posting your outcome. You are Welcome. Dave
 

Watch MrExcel Video

Forum statistics

Threads
1,129,800
Messages
5,638,416
Members
417,025
Latest member
MusterDuster

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top