My code automates various letters using cell values from excel and replacing it into a Microsoft document. When running the automation, the first few word documents were able to close except for the last one. Does anyone have a solution for this? Thanks 
VBA Code:
Option Explicit
Public Sub WordFindAndReplaceSave()
Dim ws As Worksheet, msWord As Object
Dim currentRow As Long
Dim rowCount As Long
Dim lastRow As Long
Dim filename As String
Dim Path1 As String
Dim myD2Range As Range
Dim myE2Range As Range
Dim myF2Range As Range
Dim myG2Range As Range
Dim myRange As Range
Path1 = "C:\Users\xlim\Desktop\Edited Letters"
Set ws = ActiveSheet
Set msWord = CreateObject("Word.Application")
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).row
For currentRow = 2 To lastRow
If Not ws.Rows(currentRow).Hidden Then
filename = ws.Range("C" & currentRow).Value
Set myD2Range = ws.Range("D" & currentRow)
Set myE2Range = ws.Range("E" & currentRow)
Set myF2Range = ws.Range("F" & currentRow)
Set myG2Range = ws.Range("G" & currentRow)
Set myRange = ws.Range("D" & currentRow & ":" & "G" & currentRow)
With msWord
.Visible = True
.Documents.Open "C:\Users\xlim\Desktop\Engagement letter - STC.docx"
.Activate
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "DELVIN WONG WERN LIAT"
.Replacement.Text = ws.Range("A" & currentRow).Value 'if currentRow is in use, replace firstCell with it
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "THE BOARD OF DIRECTORS"
.Replacement.Text = ws.Range("B" & currentRow).Value
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "KOOLOOK PTE. LTD."
.Replacement.Text = ws.Range("C" & currentRow).Value
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
If WorksheetFunction.CountA(myD2Range) < myD2Range.Count Then
.Text = "211 HENDERSON ROAD #03-02 211 HENDERSON SINGAPORE 159552"
.Replacement.Text = myE2Range & vbCr & myF2Range & vbCr & myG2Range
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
ElseIf WorksheetFunction.CountA(myE2Range) < myE2Range.Count Then
.Text = "211 HENDERSON ROAD #03-02 211 HENDERSON SINGAPORE 159552"
.Replacement.Text = myD2Range & vbCr & myF2Range & vbCr & myG2Range
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
ElseIf WorksheetFunction.CountA(myF2Range) < myF2Range.Count Then
.Text = "211 HENDERSON ROAD #03-02 211 HENDERSON SINGAPORE 159552"
.Replacement.Text = myD2Range & vbCr & myE2Range & vbCr & myG2Range
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
ElseIf WorksheetFunction.CountA(myG2Range) < myG2Range.Count Then
.Text = "211 HENDERSON ROAD #03-02 211 HENDERSON SINGAPORE 159552"
.Replacement.Text = myD2Range & vbCr & myE2Range & vbCr & myF2Range
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
ElseIf WorksheetFunction.CountA(myRange) = myRange.Count Then
.Text = "211 HENDERSON ROAD #03-02 211 HENDERSON SINGAPORE 159552"
.Replacement.Text = myD2Range & vbCr & myE2Range & vbCr & myF2Range & vbCr & myG2Range
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End If
End With
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "24 MAY 2019"
.Replacement.Text = ws.Range("H" & currentRow).Value
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "KPL/OAA/GTO/BK/AL"
.Replacement.Text = ws.Range("I" & currentRow).Value
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
msWord.ActiveDocument.SaveAs filename:=Path1 & "/" & "Engagement Letter - " & filename & ".docx"
msWord.ActiveDocument.Close
rowCount = rowCount + 1
End With
End If
Next currentRow
End Sub
