Problem with a Macro/ sometimes macro skip a field

Hi,

I have a code to copy a value from Excel and paste in a Word document,

The code copy a certain cell value, search a certain Text value in Word doc, then delete this text in word doc and paste the excel cell value in place

But

I had a problem with this Code, sometimes the code skip some fields, so when it tried to paste, macro show me a Error, after sometimes I add a code to verify if clipboard is empty,

Then it start to skip and ignore some Fields, so I add a code to Stop and Slow Down the macro, but i have to try the export 3 times until the macro export all fields correctly

The Worksheet is used by some people that don't know to much about Excel, so I can't have a Super Solution, I need a simple solution, but i can't think in anything

Below you are find my code, and a i'm sending the workbook and Word Document,
It's important save two files at the same place for the export works

I'm from Brazil, so some fields are in Portuguese

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()

    wdFind.Replacement.Text = ""
    wdFind.Forward = True
    wdFind.Wrap = wdFindContinue
    wdFind.Execute
    Call CheckClipBrd
    Application.Wait (Now + (TimeValue("0:00:01") / 10))
    appWd.Selection.PasteSpecial DataType:=wdPasteText
    CutCopyMode = False

End Sub

Sub CopyDatatoWord()

Dim docWD As Word.Document
Dim sheet1 As Object
Dim sheet2 As Object
Dim saveCell1 As String
Dim saveCell2 As String
Dim saveCell3 As String
Dim dir1 As String
Dim dir2 As String


    Set appWd = CreateObject("Word.Application")
    appWd.Visible = True
    Set docWD = appWd.Documents.Open(ThisWorkbook.Path & "\Quality_URK.docx")
    
    'Select Sheet where copying from in excel
    
    Sheets("copia").Visible = True
    Sheets("copia").Select
    ActiveSheet.Unprotect
    
    Set wdFind = appWd.Selection.Find
    ClipT = "  "
    ClipEmpty.SetText ClipT

    Sheets("copia").Range("B2").Copy
    wdFind.Text = "Text1"
    Call FormatPaste

   Sheets("copia").Range("B3").Copy
   Application.Wait (Now + (TimeValue("0:00:01") / 10))
    wdFind.Text = "Text21"
    Call FormatPaste

 Sheets("copia").Range("B4").Copy
 Application.Wait (Now + (TimeValue("0:00:01") / 10))
    wdFind.Text = "Text3"
    Call FormatPaste

 Sheets("copia").Range("B5").Copy
 Application.Wait (Now + (TimeValue("0:00:01") / 10))
    wdFind.Text = "Text4"
    Call FormatPaste

  Sheets("copia").Range("B6").Copy
  Application.Wait (Now + (TimeValue("0:00:01") / 10))
    wdFind.Text = "Text5"
    Call FormatPaste

   Sheets("copia").Range("B7").Copy
   Application.Wait (Now + (TimeValue("0:00:01") / 10))
    wdFind.Text = "Text6"
    Call FormatPaste

   Sheets("copia").Range("B8").Copy
   Application.Wait (Now + (TimeValue("0:00:01") / 10))
    wdFind.Text = "Text7"
    Call FormatPaste

    Sheets("copia").Range("B9").Copy
    Application.Wait (Now + (TimeValue("0:00:01") / 10))
    wdFind.Text = "Text8"
    Call FormatPaste

    Sheets("copia").Range("B10").Copy
    Application.Wait (Now + (TimeValue("0:00:01") / 10))
    wdFind.Text = "Text9"
    Call FormatPaste

    Sheets("copia").Range("B4").Copy
    Application.Wait (Now + (TimeValue("0:00:01") / 10))
    wdFind.Text = "Text31"
    Call FormatPaste

Sheets("copia").Range("B3").Copy
Application.Wait (Now + (TimeValue("0:00:01") / 10))
    wdFind.Text = "Text22"
    Call FormatPaste

    Sheets("copia").Range("B11").Copy
    Application.Wait (Now + (TimeValue("0:00:01") / 10))
    wdFind.Text = "Text10"
    Call FormatPaste

    
a = Sheets("copia").Range("B13").Text

  docWD.SaveAs (ThisWorkbook.Path & a)


Sheets("copia").Select
ActiveSheet.Protect
Sheets("copia").Visible = False

Sheets("Quality").Select


Set appWd = Nothing
Set docWD = Nothing
Set appXL = Nothing
Set wbXL = Nothing

End Sub

Sub Verifica_fill()

Dim Aviso As VbMsgBoxResult

If Sheets("quality").Range("H1") = "" Then

Aviso = MsgBox("Preencha o campo em amarelo com o número do Quality que gostaria de exportar", vbOKOnly, "AVISO!")

Else

Call CopyDatatoWord

End If


End Sub