Sub InsertText()
Dim Shp As Shape, Doc As Document, strTextToInsert As String, strTextToFind As String
Dim i As Long, docToOpen As FileDialog, sHght As Single
Dim rngToSearch As Word.Range
Dim DataObj As New MSForms.DataObject
    
    On Error GoTo Err_Exit
    'strText = InputBox("New Text", "Header Textbox Update", "New Text")
    
    ' Switch off the updates of screen
    Application.ScreenUpdating = False
    
    ' Set the text
    strTextToInsert = "Annual bonus rates for the last five years"
    strTextToFind = "Discharge Pack"
    
    DataObj.SetText strTextToInsert
    DataObj.PutInClipboard
    
    Set docToOpen = Application.FileDialog(msoFileDialogFilePicker)
    docToOpen.Show
    For i = 1 To docToOpen.SelectedItems.Count
        'Open each document
        Set Doc = Documents.Open(FileName:=docToOpen.SelectedItems(i))
            Selection.Find.ClearFormatting
        With Selection.Find
            .Text = strTextToFind
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.TypeParagraph
        Selection.PasteAndFormat (wdListCombineWithExistingList)
        ' The above inserts a line which creates a second page, so delete a line after
        Selection.EndKey Unit:=wdStory
        Selection.Delete Unit:=wdCharacter, Count:=1

        ActiveDocument.Close SaveChanges:=wdSaveChanges
    Next
    
    Set docToOpen = Nothing: Set Doc = Nothing
    ' Switch Screen updates back on
    Application.ScreenUpdating = True
    Exit Sub
Err_Exit:
    MsgBox Err.Description & Err.Number
End Sub