Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, j As Long, k As Long, para As Paragraph, Fmt As ParagraphFormat, HPos As Single
With ActiveDocument
  .DefaultTabStop = 0
  j = .Paragraphs(1).TabStops.Count
  For i = 1 To .Paragraphs.Count
    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
  Next
  .Range.ParagraphFormat = .Paragraphs(1).Range.ParagraphFormat
End With
Application.ScreenUpdating = True
End Sub