Sub MailMergeToDoc()
Application.ScreenUpdating = False
Dim Rng As Range, t As Long, r As Long, c As Long
ActiveDocument.MailMerge.Execute
With ActiveDocument.Range
  For t = 1 To .Tables.Count
    With .Tables(t)
      .AllowAutoFit = False
      .Range.ParagraphFormat.Alignment = wdAlignParagraphRight
      .Rows.Alignment = wdAlignRowCenter
      .Rows(1).HeadingFormat = True
      .Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
      .Columns.PreferredWidthType = wdPreferredWidthPoints
      .Columns.PreferredWidth = InchesToPoints(0.625)
      .Columns(1).PreferredWidth = InchesToPoints(0.75)
      .Columns(10).PreferredWidth = InchesToPoints(0.75)
      .Rows.Add: r = .Rows.Count
      .Cell(r, 1).Range.Text = "TOTAL:"
      .Rows(r).Range.Font.Bold = True
      For c = 3 To 9
        Set Rng = .Cell(r, c).Range
        Rng.Collapse wdCollapseStart
        Rng.Fields.Add Rng, wdFieldEmpty, "=SUM(ABOVE) \# £,#0", False
      Next
    End With
  Next
  .Fields.Unlink
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub