OK, try this version:
Code:
Sub FixTables()
Application.ScreenUpdating = False
Dim Tbl As Table, i As Long
With ActiveDocument
For Each Tbl In .Tables
With Tbl
With .Rows
.LeftIndent = 0
.WrapAroundText = False
.Alignment = wdAlignRowCenter
End With
.TopPadding = 0
.LeftPadding = 0
.RightPadding = 0
.BottomPadding = 0
.AllowAutoFit = False
.PreferredWidthType = wdPreferredWidthAuto
.Columns.DistributeWidth
.Columns(1).Width = CentimetersToPoints(1#)
.Columns(2).Width = CentimetersToPoints(3.75)
.Columns(3).Width = CentimetersToPoints(3.75)
.Columns(4).Width = CentimetersToPoints(3.75)
.Columns(5).Width = CentimetersToPoints(3.75)
End With
While .Tables.Count > 1
.Tables(1).Range.Characters.Last.Next.Delete
Wend
Next
End With
Application.ScreenUpdating = True
End Sub
What are the prompts? Without knowing what they are, I can't say whether there's a better approach than toggling Displayalerts.