Try:
Code:
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