Creating a Word Doc using Excel VBA

[George4923]

Hi, I am pretty new to using excel and my boss has tasked me with creating a automated tool but it keeps failing. I am trying to copy values in excel to fill in a template document. Attached below is some code I found on youtube but it keeps failing at random points. I am new to the forum, so would appreciate any help.

Private Sub generateOffer_Click()
Dim wdApp As Word.Application
Dim SaveAsName As String
Dim tableRange As Range
Dim wordTable As Object
Dim lastRow As Long

Set wdApp = New Word.Application

With wdApp
.Visible = True
.Activate

.Documents.Add "***Location Offer Template.dotx***"

'Customer Details
Sheet1.Range("D8").Copy
.Selection.Goto wdGoToBookmark, , , "Attention"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

Sheet1.Range("D7").Copy
.Selection.Goto wdGoToBookmark, , , "Customer"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

Sheet1.Range("D13").Copy
.Selection.Goto wdGoToBookmark, , , "Address"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

Sheet1.Range("D14").Copy
.Selection.Goto wdGoToBookmark, , , "Suburb"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

Sheet1.Range("D15").Copy
.Selection.Goto wdGoToBookmark, , , "State"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

Sheet1.Range("D16").Copy
.Selection.Goto wdGoToBookmark, , , "Postcode"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

'Quote Ref
Sheet1.Range("D12").Copy
.Selection.Goto wdGoToBookmark, , , "BFO"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

Sheet1.Range("C49").Copy
.Selection.Goto wdGoToBookmark, , , "rev"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

Sheet1.Range("D8").Copy
.Selection.Goto wdGoToBookmark, , , "Attention2"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

Sheet1.Range("D23").Copy
.Selection.Goto wdGoToBookmark, , , "PrepBy"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

'Customer Details
Sheet1.Range("D8").Copy
.Selection.Goto wdGoToBookmark, , , "Attention3"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

Sheet1.Range("D7").Copy
.Selection.Goto wdGoToBookmark, , , "Customer2"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

Sheet1.Range("D13").Copy
.Selection.Goto wdGoToBookmark, , , "Address2"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

Sheet1.Range("D14").Copy
.Selection.Goto wdGoToBookmark, , , "Suburb2"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

Sheet1.Range("D15").Copy
.Selection.Goto wdGoToBookmark, , , "State2"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

Range("D16").Copy
.Selection.Goto wdGoToBookmark, , , "Postcode2"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

'Quote Ref
Sheet1.Range("D12").Copy
.Selection.Goto wdGoToBookmark, , , "BFO2"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

Sheet1.Range("C49").Copy
.Selection.Goto wdGoToBookmark, , , "rev2"
.Selection.PasteSpecial Link:=False, DataType:=wdPasteText

'BOQ Table
Call GenerateTable
' Find the last row with data in the Excel worksheet
lastRow = Sheet14.Cells(Sheet14.Rows.Count, "A").End(xlUp).Row

' Define the dynamic range of the table in Excel
Set tableRange = Sheet14.Range("A1:E" & lastRow)

tableRange.Copy
.Selection.Goto wdGoToBookmark, , , "BOQ"
.Selection.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False

SaveAsName = "***Name of Doc***" _
& Format(Now, "yyyy-mm-dd hh-mm-ss") & ".docx"

.ActiveDocument.SaveAs2 SaveAsName
.ActiveDocument.Close
.Quit
End With
End Sub

Sub GenerateTable()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim tableRows As Long
Dim rowCounter As Long

Sheet14.Range("A:E").ClearContents

tableRows = Sheet13.Range("H1") + 1

' Start a new table in Sheet1
Sheet14.Range("A1:E1").Value = Array("Item No", "Description", "Qty", "Net Unit Price", "Net Total Value")

' Loop through the rows in Sheet2 and populate the table in Sheet1
For rowCounter = 1 To tableRows
' Populate the table in Sheet1 with data from Sheet2
Sheet14.Cells(rowCounter, 1).Value = Sheet13.Cells(rowCounter, 1).Value
Sheet14.Cells(rowCounter, 2).Value = Sheet13.Cells(rowCounter, 2).Value
Sheet14.Cells(rowCounter, 3).Value = Sheet13.Cells(rowCounter, 3).Value
Sheet14.Cells(rowCounter, 4).Value = Sheet13.Cells(rowCounter, 4).Value
Sheet14.Cells(rowCounter, 5).Value = Sheet13.Cells(rowCounter, 5).Value
Next rowCounter
End Sub

 

[George4923]

this is the error I am getting. Sometimes it works but most of the time this pops up at a random point in the code

 

[rikvny02]

View attachment 114940
this is the error I am getting. Sometimes it works but most of the time this pops up at a random point in the code

Is there a reason you can't do a mail merge from excel to word?