Sub Demo3() 
    Dim rng As Range, i As Long 
    Dim Shp As shape 
    Dim 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) 
            End If 
        Next 
        With rng.Find 
            For Each iShp In rng.InlineShapes 
                If iShp.TextEffect.Text = "TARIQ" Then 
                    iShp.TextEffect.Text = "Johnson" 
                End If 
            Next 
        End With 
    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