Copy Excel Table into existing Word Document stored on Sharepoint

[jessitarexcel]

I have spent days now searching for a solution to this problem and none of the solutions I have found work. I really need help with this macro. It should work, I have written so many iterations it is ridiculous and have watched a heap of Youtube videos as well. Any assistance is sincerely appreciated. I have made sure that Microsoft and Microsoft Word Objects 16.0 is selected in references.

The text in red isn't working. Is it the name of the tab that is the issue?

This is the latest instance of the VBA and I will post the other versions I have tried in comments below this post.

Dim wordObject As Object
Dim wordDocument As Object
Dim wordTable As Object

Application.ScreenUpdating = False
Application.EnableEvents = False

ThisWorkbook.Worksheet(COW and Stat Dec Table.Name).ListObjects("StatDecTable").Range

On Error Resume Next
Set WordApp = GetObject(class:="Word.Application")
If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")

Set pageEditor = xInspect.WordEditor
WordApp.Visible = True
WordApp.Activate
WordApp.Documents.Open "Link Removed for Privacy" (The link does work and the right word document opens but it won't paste the table)

Stat Dec and COW Table - New.Range("StatDecTable"[#All]").Copy
mydoc.Paragraphs(1).Range.PasteExcelTable_
LinkedtoExcel = False, _
WordFormatting = False, _
RTF: = False

Application.ScreenUpdating = True
Application.EnableEvents = True
Set pageEditor = Nothing
'Clear the clipboard
Application.CutCopyMode = False

End Sub

 

[jessitarexcel]

I also removed Private from Sub and that still causes the 5174 error

 

[jessitarexcel]

Okay I have tried this again and it gets hung up on the this section:

Set tbl = ThisWorkbook.Worksheets("COW and Stat Dec Table") _
.ListObjects("StatDecTable[#All]").Range

I made a change to the tab name but everything else has stayed the same. This is the full code that I used below:

Sub CopytoStatDec_Click()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim tbl As Range, objdoc As Object, WordTbl As Object

'create Word app
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set WordApp = CreateObject("Word.Application")
End If
On Error GoTo 0

WordApp.Visible = True

Set objdoc = WordApp.Documents.Open("Link Removed")
Set tbl = ThisWorkbook.Worksheets("COW and Stat Dec Table") _
.ListObjects("StatDecTable[#All]").Range
tbl.Copy
WordApp.ActiveDocument.Select
WordApp.Selection.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False

With objdoc
Set WordTbl = .Tables(1)
With WordTbl
.AutoFitBehavior (wdAutoFitContent)
End With
End With
End Sub

I just cannot figure out why this won't work. I wonder if there is some sort of security issue but I am using my own copy of Office 365 and I have macros enabled. The document opens but it just won't do anything with the table. I don't understand it.

 

[NdNoviceHlp]

The WordDoc variable I replaced with objdoc so is no longer needed. I don't usually use early binding and the code will work for late binding so you can change the Dim WordApp as Object. You may also need to change the .AutoFitBehaviour(1). If an error continues to occur, could you please indicate what line the error occurs on. Dave

Set tbl = ThisWorkbook.Worksheets("COW and Stat Dec Table") _
.ListObjects("StatDecTable[#All]").Range

If you click on your table, the .ListObjects("StatDecTable[#All]").Range part should contain what the table is named in the upper left name manager ie. replace StatDecTable[#All] with the table name

 

[jessitarexcel]

The WordDoc variable I replaced with objdoc so is no longer needed. I don't usually use early binding and the code will work for late binding so you can change the Dim WordApp as Object. You may also need to change the .AutoFitBehaviour(1). If an error continues to occur, could you please indicate what line the error occurs on. Dave

Set tbl = ThisWorkbook.Worksheets("COW and Stat Dec Table") _
.ListObjects("StatDecTable[#All]").Range

If you click on your table, the .ListObjects("StatDecTable[#All]").Range part should contain what the table is named in the upper left name manager ie. replace StatDecTable[#All] with the table name

Hi Dave, thank you for your assistance. I sincerely appreciate it. I do have the right table name, StatDecTable is the name of the table.

This is the part that it gets hung up on as per my last reply:

Set tbl = ThisWorkbook.Worksheets("COW and Stat Dec Table") _
.ListObjects("StatDecTable[#All]").Range

And this is the full code as it stands currently - the part highlighted in red is where it stops:

Sub CopytoStatDec_Click()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim tbl As Range, objdoc As Object, WordTbl As Object

'create Word app
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set WordApp = CreateObject("Word.Application")
End If
On Error GoTo 0

WordApp.Visible = True

Set objdoc = WordApp.Documents.Open("Link Removed")
Set tbl = ThisWorkbook.Worksheets("COW and Stat Dec Table") _
.ListObjects("StatDecTable[#All]").Range
tbl.Copy
WordApp.ActiveDocument.Select
WordApp.Selection.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False

With objdoc
Set WordTbl = .Tables(1)
With WordTbl
.AutoFitBehavior (wdAutoFitContent)
End With
End With
End Sub

If I make the following change:

Sub CopytoStatDec_Click()
Dim WordApp As Object
Dim WordDoc As Word.Document
Dim tbl As Range, objdoc As Object, WordTbl As Object

'create Word app
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set WordApp = CreateObject("Word.Application")
End If
On Error GoTo 0

WordApp.Visible = True

Set objdoc = WordApp.Documents.Open("Link Removed")
Set tbl = ThisWorkbook.Worksheets("COW and Stat Dec Table") _
.ListObjects("StatDecTable[#All]").Range
tbl.Copy
WordApp.ActiveDocument.Select
WordApp.Selection.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False

With objdoc
Set WordTbl = .Tables(1)
With WordTbl
.AutoFitBehavior(1) (wdAutoFitContent)
End With
End With
End Sub

I have tried this variant above and get the following error:

Invalid or unqualified reference as per the screenshot attached. I have blacked out the link only but the yellow highlighted section is the part that has the reference error.

The part it seems to have an issue with is:

.ListObjects("StatDecTable[#All]").Range

 

[NdNoviceHlp]

If "StatDecTable is the name of the table" then why do you have...

Set tbl = ThisWorkbook.Worksheets("COW and Stat Dec Table") _
.ListObjects("StatDecTable[#All]").Range

I don't get it. Why do you keep putting the [#All] where it does not belong? Dave

 

[jessitarexcel]

If "StatDecTable is the name of the table" then why do you have...

Set tbl = ThisWorkbook.Worksheets("COW and Stat Dec Table") _
.ListObjects("StatDecTable[#All]").Range

I don't get it. Why do you keep putting the [#All] where it does not belong? Dave

Don't I have to select all headers? That is why all is there. [] refers to the table headers.

 

[jessitarexcel]

I took the all out, it still doesn't work. Same error as my last post.

Sub CopytoStatDec_Click()

Dim WordApp As Object

Dim WordDoc As Word.Document

Dim tbl As Range, objdoc As Object, WordTbl As Object



'create Word app

On Error Resume Next

Set WordApp = GetObject(, "Word.Application")

If Err.Number <> 0 Then

Set WordApp = CreateObject("Word.Application")

End If

On Error GoTo 0



WordApp.Visible = True



Set objdoc = WordApp.Documents.Open("https://a02communityrecovery.sharep... 27 July 2022 (APPROVED) - Jess Test Doc.docx")

Set tbl = ThisWorkbook.Worksheets("COW and Stat Dec Table") _

.ListObjects("StatDecTable").Range

tbl.Copy

WordApp.ActiveDocument.Select

WordApp.Selection.PasteExcelTable _

LinkedToExcel:=False, _

WordFormatting:=False, _

RTF:=False



With objdoc

Set WordTbl = .Tables(1)

With WordTbl

.AutoFitBehavior(1) (wdAutoFitContent)

End With

End With

End Sub

 

[jessitarexcel]

 

[NdNoviceHlp]

Are you sure your sheet name is correct? It used to be "Stat Dec and COW Table - New" and then you renamed it. Are you sure there are no unseen spaces in the new sheet name. I've tested the code and it copies the table with header to the document. Trial this...

Sub test()
Dim sht As Worksheet, sh As Worksheet, tbl As ListObject
For Each sht In ThisWorkbook.Sheets
MsgBox sht.Name & "   " & Len(sht.Name)
Set sh = ThisWorkbook.Sheets(sht.Name)
For Each tbl In sh.ListObjects
MsgBox tbl.Name & "   " & Len(tbl.Name)
Next tbl
Next sht
'Stat Dec and COW Table 22
'StatDecTable 12
End Sub

Dave

 

[jessitarexcel]

Are you sure your sheet name is correct? It used to be "Stat Dec and COW Table - New" and then you renamed it. Are you sure there are no unseen spaces in the new sheet name. I've tested the code and it copies the table with header to the document. Trial this...

Sub test()
Dim sht As Worksheet, sh As Worksheet, tbl As ListObject
For Each sht In ThisWorkbook.Sheets
MsgBox sht.Name & "   " & Len(sht.Name)
Set sh = ThisWorkbook.Sheets(sht.Name)
For Each tbl In sh.ListObjects
MsgBox tbl.Name & "   " & Len(tbl.Name)
Next tbl
Next sht
'Stat Dec and COW Table 22
'StatDecTable 12
End Sub

Dave

Cheers Dave, I will double check the name but I am pretty sure it is right (only because I checked it twice as I had made the change) unless there is accidentally a space at the end of the name or something silly like that. I will also try trial the code you have sent through above and let you know how I go.