Excel VBA

Hi,

I have this macro.

Option Explicit

Sub CreateWordDocuments()
Dim CustCol As Long
Dim DocLoc, TagName, TagValue, Template, FileName As String
Dim WordDoc, WordApp As Object
Dim tbl As Excel.Range
With Sheet2

Application.ScreenUpdating = False
Application.EnableEvents = False

Set Template = Sheet1.Range("D12")

Select Case Template
Case "Standard Clean"
DocLoc = ThisWorkbook.Path & "\AAA Project Standard Clean Submission Template.docx" 'Word Document Filename
Case "Degreasing"
DocLoc = ThisWorkbook.Path & "\AAA Project Degrease Submission Template.docx" 'Word Document Filename
Case "Mould Removal"
DocLoc = ThisWorkbook.Path & "\AAA Project Mould Removal Submission Template.docx" 'Word Document Filename
Case "Custom"
DocLoc = ThisWorkbook.Path & "\AAA Project Submission Template.docx" 'Word Document Filename
End Select

Set tbl = Sheet1.ListObjects("PricingInput").Range

ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & .Range("B2").Value & " - Project Calculation Sheet - " & .Range("D2").Value & " - " & .Range("I2").Value & " - " & .Range("K2").Value & ".xlsm"

'Open Word Template
On Error Resume Next 'If Word is already running
Set WordApp = GetObject("Word.Application")
If Err.Number <> 0 Then
'Launch a new instance of Word
Err.Clear
'On Error GoTo Error_Handler
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True 'Make the application visible to the user
End If

Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False) 'Open Template
For CustCol = 1 To 13 'Move Through 13 Columns
TagName = .Cells(1, CustCol).Value 'Tag Name
TagValue = .Cells(2, CustCol).Value 'Tag Value
With WordDoc.Content.Find
.Text = TagName
.Replacement.Text = TagValue
.Wrap = 1
.Execute Replace:=2 'Find & Replace all instances
End With
Next CustCol

tbl.Copy 'Copy Excel Table Range

'Paste Table into MS Word
WordDoc.Bookmarks("Pricing").Range.PasteExcelTable _
LinkedToExcel:=False, _
WordFormatting:=True, _
RTF:=False

FileName = ThisWorkbook.Path & "\" & .Range("B2").Value & " - Project Submission - " & .Range("D2").Value & " - " & .Range("I2").Value & " - " & .Range("K2").Value & ".docx"
WordDoc.SaveAs FileName
'Kill (FileName) 'Deletes the PDF or Word that was just created
'WordApp.Quit
WordApp.Visible = True
WordApp.Activate

Application.ScreenUpdating = True
Application.EnableEvents = True

Application.CutCopyMode = False
End With
End Sub

Which was working on Friday but does not seem to be working since Monday. Any idea why?