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