Running consecutive subs in MS Word via Excel VBA

Question

Im new to VBA and trying to export data out of a Excel form into a MS Word quote using content control into single column tables. I found this vba code on the web which gets me what I want, however the script opens and closes the word document each time I apply the sub. I want them to run consecutively until the final save command.
Can you help me run the second sub without closing and opening the word document every time

Thanks Dim

Sub Service_Desc_toWord()

Dim wordApp As Word.Application
    Dim wDoc As Word.Document
    Dim r As Integer
    
    Set wordApp = CreateObject("word.application")
    Set wDoc = wordApp.Documents.Open(ThisWorkbook.Path & "/" & Range("O1").Value & ".docx")
    wordApp.Visible = True
    r = 43
    
    For i = 131 To 143
    
        wDoc.ContentControls(i).Range.Text = Sheets("Configuration").Cells(r, 4)
        'Sheets("Configuration").Cells(r,4)=wDoc.ContentCOntrols(i).Range.Text
        r = r + 1
        
    Next i
    
    wordApp.Documents.Close
    wordApp.Quit
    Service_Qty_toWord
End Sub

Sub Service_Qty_toWord()

Dim wordApp As Word.Application
    Dim wDoc As Word.Document
    Dim r As Integer
    
    Set wordApp = CreateObject("word.application")
    Set wDoc = wordApp.Documents.Open(ThisWorkbook.Path & "/" & Range("O1").Value & ".docx")
    wordApp.Visible = True
    r = 43
    
    For i = 144 To 156
    
        wDoc.ContentControls(i).Range.Text = Sheets("Configuration").Cells(r, 1)
        'Sheets("Configuration").Cells(r,1)=wDoc.ContentCOntrols(i).Range.Text
        r = r + 1
        
    Next i
    
    wordApp.ActiveDocument.SaveAs2 Filename:="Quote Letter", FileFormat:= _
        wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
        :=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
        :=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False, CompatibilityMode:=15

End Sub

Answer 1

    Sub Service_Desc_toWord()
Dim wordApp As Word.Application
Dim wDoc As Word.Document
Dim r As Integer
Set wordApp = CreateObject("word.application")
Set wDoc = wordApp.Documents.Open(ThisWorkbook.Path & "/" & Range("O1").Value & ".docx")
wordApp.Visible = True
r = 43
For i = 131 To 143
wDoc.ContentControls(i).Range.Text = Sheets("Configuration").Cells(r, 4)
'Sheets("Configuration").Cells(r,4)=wDoc.ContentCOntrols(i).Range.Text
r = r + 1
Next i
r = 43
For i = 144 To 156
wDoc.ContentControls(i).Range.Text = Sheets("Configuration").Cells(r, 1)
'Sheets("Configuration").Cells(r,1)=wDoc.ContentCOntrols(i).Range.Text
r = r + 1
Next i
wordApp.ActiveDocument.SaveAs2 Filename:="Quote Letter", FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=15
wordApp.Documents.Close
wordApp.Quit
End Sub