Sub Test_Replace()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "sample"
    .Replacement.Text = "Sample"
    .Format = False
    .Forward = False
    .Wrap = wdFindStop
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    .Execute Replace:=wdReplaceAll
  End With
  Do While .Find.Execute
    If .Information(wdWithInTable) = True Then
      Set Rng = ActiveDocument.Tables(1).Cell(1, 0)
        Do While Rng.Tables.Count > 0
       Loop
      Exit Do
    End If
    .Collapse wdCollapseStart
  Loop
End With
Application.ScreenUpdating = True
End Sub