You might try something along the lines of the following macro:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ":[^s]{1,}"
.Replacement.Text = ":^t"
.Forward = True
.Format = False
.MatchWildcards = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
.Wrap = wdFindStop
.Text = "Command:*Help:*^13"
.Execute
End With
Do While .Find.Found
Set Rng = .Duplicate
With .Duplicate
With .Find
.Forward = True
.Format = False
.MatchWildcards = True
.Text = "[^13]{2,}"
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
.Text = ":[^t ]@^13"
.Replacement.Text = ":^t"
.Execute Replace:=wdReplaceAll
.Text = "^t*^13[!^t]@^13"
.Execute
End With
Do While .Find.Found
If Not .InRange(Rng) Then Exit Do
With .Paragraphs.Last.Range
.InsertBefore vbTab
End With
.End = .Paragraphs.Last.Range.Start
.Collapse wdCollapseEnd
.Find.Execute
Loop
With Rng
With .Find
.Forward = True
.Format = False
.MatchWildcards = True
.Text = "^13^t"
.Replacement.Text = "¶"
.Execute Replace:=wdReplaceAll
End With
.ConvertToTable Separator:=vbTab, NumColumns:=2, AutoFitBehavior:=wdAutoFitContent
.Tables(1).Style = "Table Grid"
With .Find
.Text = "¶"
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
End With
End With
End With
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
End With
Application.ScreenUpdating = True
End Sub