Sub RemoveWord()
Dim rngStory As Range
For Each rngStory In ActiveDocument.StoryRanges
  With rngStory.Find
    .Text = "Do"
    .Replacement.Text = "Done
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
  End With
Next rngStory
End Sub