Try:
Code:
Sub OCLayin_CreateQuote()
'Collect the Needed Information
Dim myProject, myCompanyInfoL1, myCompanyInfoL2, myCompanyInfoL3, myQuoteNumber As String
Dim mycustomer, mydate As String, myuser As String, myDate1 As String, myDate2 As String, myDate3 As String
Dim myFileName As String
Dim wrdApp As Word.Application, wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
Application.ScreenUpdating = False
With ActiveWorkbook.Sheets("Project Setup")
myProject = .Range("B4").Text
myCompanyInfoL1 = .Range("B8").Text
myCompanyInfoL2 = .Range("B6").Text & " - " & .Range("B7").Text
myCompanyInfoL3 = .Range("B5").Text
myQuoteNumber = .Range("E4").Text
mycustomer = .Range("B6").Text
mydate = .Range("E5").Text
myuser = .Range("E7").Text
myDate1 = .Range("A45").Text
End With
Set wrdDoc = wrdApp.Documents.Add(Template:= _
"G:\ABP\ArchSpec\A-Operations\Group Templates\Quote Templates\OpenCellQuote.dotx")
Do While wrdDoc Is Nothing: Loop
With wrdDoc
If .Bookmarks.Exists("Project") Then .Bookmarks("Project").Range.Text = myProject
If .Bookmarks.Exists("ToL1") Then .Bookmarks("ToL1").Range.Text = myCompanyInfoL1
If .Bookmarks.Exists("ToL2") Then .Bookmarks("ToL2").Range.Text = myCompanyInfoL2
If .Bookmarks.Exists("ToL3") Then .Bookmarks("ToL3").Range.Text = myCompanyInfoL3
If .Bookmarks.Exists("Date") Then .Bookmarks("Date").Range.Text = mydate
If .Bookmarks.Exists("User") Then .Bookmarks("User").Range.Text = myuser
If .Bookmarks.Exists("QuoteNo") Then .Bookmarks("QuoteNo").Range.Text = myQuoteNumber
If .Bookmarks.Exists("Esc") Then .Bookmarks("Esc").Range.Text = myDate1
If .Bookmarks.Exists("Table") Then
ThisWorkbook.Sheets("Quote OC Lay-in").Range("A11:H40").Copy
.Bookmarks("Table").Range.Paste
End If
myFileName = myProject & " " & myQuoteNumber & "_" & mycustomer & " " & "Quote" & " "
With wrdApp.Dialogs(wdDialogFileSummaryInfo)
.Title = myFileName
.Execute
End With
.SaveAs2 "G:\ABP\ArchSpec\Project Files\Quotes\2014\Premium\MW Open Cell\" _
& myFileName & Format(Date, "mm-dd-yy") & ".docx", _
FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
End With
wrdApp.Visible = True
Set wrdDoc = Nothing: Set wrdApp = Nothing
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Note the revised code structure and the loop that forces Word to wait until the document being created is ready.