Sub Demo()
Application.ScreenUpdating = False
Dim Tbl As Table, r As Long, Rng As Range, StrTC As String
For Each Tbl In ActiveDocument.Tables
  With Tbl
    If Split(.Cell(1, 1).Range.Text, vbCr)(0) = "ATA - SYSTEM &" Then
      For r = 5 To .Rows.Count
        StrTC = "TC " & Chr(34) & Split(.Cell(r, 1).Range.Text, vbCr)(0)
        Set Rng = .Cell(r, 2).Range
        With Rng
          .End = .End - 1
          StrTC = StrTC & " " & .Text & Chr(34) & " \l 5"
          .Collapse wdCollapseEnd
          .Fields.Add .Duplicate, wdFieldEmpty, StrTC, False
        End With
      Next
    End If
  End With
Next
Application.ScreenUpdating = True
End Sub