Without knowing how the pages are separated it is difficult to produce a loop that will loop through the pages. However given your description the folllowing will find the wanted xxx strings in the document, which should help you on your way.
If this is the result of a mail merge you might find http://www.gmayor.com/MergeAndSplit.htm useful
Dim oRng As Range
Dim sName As String
Set oRng = ActiveDocument.Range
With oRng.Find
Do While .Execute(FindText:="Transport Company Anytown LTP" & Chr(9) & "MB" & Chr(9))
sName = "Diagram "
oRng.Collapse 0
oRng.MoveEnd wdWord
sName = sName & oRng.Text
MsgBox sName
oRng.Collapse 0
Loop
End With