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]

Dim WordApp As Word.Application
Dim WordDoc As Word.Document

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

WordApp.Visible = True
WordApp.Activate
WordApp.Documents.Open "Link Removed"

I know that the above works to locate and open the word document from Sharepoint so that issue is resolved. The issue is the copy and paste part.

 

[jessitarexcel]

This was my first attempt:

Private Sub CommandButton1_Click()
Dim tblRange As Excel.Range
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim WordTable As Word.Table

Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim lnCountItems As Long
Dim vaData As Variant

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

WordApp.Visible = True
WordApp.Activate
WordApp.Documents.Open "Link Removed"

Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Stat Dec and COW Table - New")
Set tblRange = ThisWorkbook.Worksheets("Stat Dec and COW Table - New").Range("A2:D44")
vaData = wsSheet.Range("A2:D44").Value
XlTbl.Copy

Set WrdTbl = WrdDoc.Tables
With WrdTbl
.AutoFitBehavior (wdAutoFitWindow)
.Rows.DistributeHeight
.Range.ParagraphFormat.SpaceBefore = 0
.Range.ParagraphFormat.SpaceAfter = 0
.AutoFitBehavior 2 'wdAutoFitWindow
End With

'Insert Table Caption
'TblTitle = "Scope of Works"
'WrdTbl.Range.InsertCaption Label:="Table", TitleAutoText:="", Title:=" - " & TblTitle, _
'Position:=wdCaptionPositionAbove, ExcludeLabel:=0

End Sub

 

[jessitarexcel]

This is my second attempt - this also does not work:

Sub ExcelToWord()

Dim WordApp As Word.Application

Dim mydoc As Word.Document

Set WordApp = New Word.Application

WordApp.Visible = True

Set mydoc = WordApp.Documents.Add()

ThisWorkbook.Worksheets("Stat Dec and COW Table - New").Range("A1:A44").Copy

mydoc.Paragraphs(1).Range.PasteSpecial Link:=False, DataType:=2 ' wdPasteText
Application.CutCopyMode = False

End Sub

 

[jessitarexcel]

Sub ExcelToWord()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document

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

WordApp.Visible = True
WordApp.Activate
WordApp.Documents.Open "Link Removed"

ThisWorkbook.Worksheets("Stat Dec and COW Table - New").Range("A1:A44").Copy

WordDoc.Paragraphs(1).Range.PasteSpecial Link:=False, DataType:=2 ' wdPasteText
Application.CutCopyMode = False

End Sub

The one above doesn't work properly either - it won't copy the table - the document opens up but it just won't copy

 

[jessitarexcel]

Sub ExcelToWord()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document

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

WordApp.Visible = True
WordApp.Activate
WordApp.Documents.Open "Link Removed"

ThisWorkbook.Worksheets("Stat Dec and COW Table - New").Range("StatDecTable[#All]").Select
Selection.Copy
Selection.PasteExcelTable False, False, False
Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)

End Sub

 

[jessitarexcel]

And this is the final iteration. It is clear I am getting something wrong and I would like any advice

Sub ExcelToWord()

Dim WordApp As Word.Application
Dim WordDoc As Word.Document

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

WordApp.Visible = True
WordApp.Activate
WordApp.Documents.Open "Link Removed"

ThisWorkbook.Worksheets("Stat Dec and COW Table - New").Range("StatDecTable[#All]").Select
tbl.Copy
myDoc.Paragraphs(1).Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=False, _
RTF:=False
Selection.Tables(1).AutoFitBehavior (wdAutoFitContent)

End Sub

 

[jessitarexcel]

Any tips on what I am getting wrong would also be super helpful. I am trying to improve my VBA skills and would like to know what it is that I am not understanding.

 

[NdNoviceHlp]

Hi jessitarexcel. Seems like you're not having much luck with this one. You can trial this code. HTH. Dave

Sub Test()
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("Stat Dec and COW Table - New") _
                                 .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

ps. please use code tags

 

[jessitarexcel]

Hello Dave,

Thank you for your help. Unfortunately this doesn't work for me. I keep getting Error 9, subscript out of range.

I replaced:
Sub Test()
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim tbl As Range, objdoc As Object, WordTbl As Object

With:

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

Now I get Run-Time Error '5174' Application defined or object defined error.

Sorry next time I will add code tags to the original post.