Need help inserting code to fix a excel bug

Hi All
I have some code that runs through a excel workbook and copies certain bits to a word document. This all works fine but it will randomly add two ?? to one or more places it was supposed to copy the information to. This does not always happen and it is not always in the same place. Trying to find what the cause is i came across this article
https://www.thespreadsheetguru.com/blog/2015/1/13/how-to-use-vba-code-to-copy-text-to-the-clipboard 

The problem i have now is that i'm not sure of how to add this to my code can someone please assist me with this see code below

Public Declare Function CountClipboardFormats Lib "user32" () As Long

Dim appWd As Word.Application
Dim wdFind As Object
Dim ClipEmpty As New MSForms.DataObject
Dim ClipT As String

Function IsClipboardEmpty() As Boolean
    IsClipboardEmpty = (CountClipboardFormats() = 0)
End Function

Sub CheckClipBrd()

If IsClipboardEmpty() = True Then
ClipEmpty.PutInClipboard
End If
End Sub

Sub FormatPaste()

    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    Call CheckClipBrd
    appWd.Selection.Paste
    CutCopyMode = False

End Sub

Sub NoFormatPaste()
On Error GoTo myLine

    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    Call CheckClipBrd
myline2:
    appWd.Selection.PasteSpecial DataType:=wdPasteText
    CutCopyMode = False
Exit Sub
myLine:
If Err.Number = 4198 Then
    GoTo myline2
End If
End Sub

Sub CopyDatatoWord()

Dim docWD As Word.Document
Dim rngTable As Range
Dim cell As Range
Dim rngChart As Range
Dim rngPChart As Range
Dim PCell As Range
Dim CCell As Range
Dim sh As Worksheet
Dim cht As ChartObject
Dim x
Dim y
Dim strPath As String
Dim sNow As String
Dim strSPath As String

strPath = Sheets("Sheet1").Range("A2").Value
strSPath = Sheets("Sheet1").Range("A4").Value
Application.ScreenUpdating = False


    Set appWd = CreateObject("Word.Application")
    appWd.Visible = True

'Need to change this to look at a cell value

    Set docWD = appWd.Documents.Open(strPath)


    Set wdFind = appWd.Selection.Find
    ClipT = "  "
    ClipEmpty.SetText ClipT
    
Set rngTable = Sheets("Sheet1").Range("D2:D" & Cells(Rows.Count, 4).End(xlUp).Row)
'MsgBox Sheets("Sheet1").Cells(Rows.Count, 4).End(xlUp).Row

    For Each cell In rngTable
        If cell.Value = "" Then
            GoTo myExit
        Else
        y = 1
            Application.Goto Reference:=cell.Value
            Selection.Copy
            wdFind.Text = cell.Value
            
            Dim MyDoc As String, txt As String, t As String
            MyDoc = docWD.Range.Text
            txt = cell.Value
            t = Replace(MyDoc, txt, "")
            x = (Len(MyDoc) - Len(t)) / Len(txt)
 Do While x >= y
            Call NoFormatPaste
            y = y + 1
Loop
        End If
    Next cell
myExit:

'This does non Pivot type charts
Set rngChart = Sheets("Sheet1").Range("F2:F" & Cells(Rows.Count, 6).End(xlUp).Row)
    For Each CCell In rngChart
        If CCell.Value = "" Then
            GoTo MyExit2
        Else
            Application.Goto Reference:=CCell.Value
            Selection.Copy
            wdFind.Text = CCell.Value
            
            Call FormatPaste
        End If
    Next CCell

MyExit2:

Set rngPChart = Sheets("Sheet1").Range("H2:H" & Cells(Rows.Count, 8).End(xlUp).Row)

For Each PCell In rngPChart
    If PCell.Value = "" Then
        GoTo MyExit3
    Else
        For Each sht In ActiveWorkbook.Worksheets
            For Each cht In sht.ChartObjects
                If PCell.Value = cht.Name Then
                    cht.Activate
                    cht.Copy
                    wdFind.Text = PCell.Value
                    Call FormatPaste
                End If
            Next cht
        Next sht
    End If
Next PCell

MyExit3:
sNow = Format((Now), "yyyy_mm_dd_hh_mm_ss")
'docWD.SaveAs ("C:\Users\ElmoJ\Documents\Aaron\From Client\Test2.docx")
docWD.SaveAs strSPath & "\Output_" & sNow & ".docx"
    'appWD.Quit

Set appWd = Nothing
Set docWD = Nothing
Set appXL = Nothing
Set wbXL = Nothing
Set wdFind = Nothing
Set rngTable = Nothing
Set rngChart = Nothing
Set rngPChart = Nothing
 ClipT = Empty
Set ClipEmpty = Nothing
Application.ScreenUpdating = True

End Sub

Select allOpen in new window

Thanks in advance
Elmo