Sub Demo()
Dim Rng As Range, i As Long
Dim Shp As Shape, iShp As InlineShape
Dim StrFnd As String, StrRep As String
StrFnd = "Tariq": StrRep = "Johnson"
With ActiveDocument.Range
  Set Rng = .GoTo(What:=wdGoToPage, Name:=1)
  Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
  With Rng
    .Copy
    For i = 1 To 10
      .InsertAfter vbCr & Chr(12)
      .Collapse wdCollapseEnd
      .Paste
    Next
  End With
  Set Rng = .GoTo(What:=wdGoToPage, Name:=5)
  Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
  Call Update(Rng, StrFnd, StrRep)
  For Each Shp In Rng.ShapeRange
    If Shp.TextFrame.HasText = True Then
      Call Update(Shp.TextFrame.TextRange, StrFnd, StrRep)
    Next
  Next
  For Each iShp In Rng.InlineShapes
    If iShp.TextFrame.HasText = True Then
      Call Update(iShp.TextFrame.TextRange, StrFnd, StrRep)
    Next
  Next
End With
End Sub
  
 Sub Update(Rng As Range, StrFnd As String, StrRep As String)
  With Rng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = StrFnd
    .Replacement.Text = StrRep
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchCase = True
    .MatchWholeWord = True
    .Execute Replace:=wdReplaceAll
  End With
End Sub