Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^t"
    .Forward = True
    .Wrap = wdFindStop
  End With
  Do While .Find.Execute = True
    .Start = .Paragraphs(1).Range.Start
    If Len(.Text) - Len(Replace(.Text, vbTab, "")) > 1 Then .Characters.Last.Text = " "
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
End Sub