Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, j As Long, k As Long, l As Long
Dim para As Paragraph, Fmt As ParagraphFormat, HPos As Single
With ActiveDocument
  .DefaultTabStop = 0
  j = .Paragraphs(1).TabStops.Count
  l = .Paragraphs.Count
  For i = 1 To l
    Application.StatusBar = "Processing paragraph " & i & " of " & l
    For k = 1 To j
      If .Paragraphs(i).Range.Characters.Last.Information(wdHorizontalPositionRelativeToTextBoundary) < _
        .Paragraphs(1).TabStops(k).Position Then .Paragraphs(i).Range.Characters.Last.InsertBefore vbTab
    Next
    While (Len(.Paragraphs(i).Range.Text) - Len(Replace(.Paragraphs(i).Range.Text, vbTab, ""))) < j
      .Paragraphs(i).Range.InsertBefore vbTab
    Wend
    If i Mod 100 = 0 Then DoEvents
  Next
  .Range.ParagraphFormat = .Paragraphs(1).Range.ParagraphFormat
End With
Application.StatusBar = "Done!!"
Application.ScreenUpdating = True
End Sub