Sub Demo()
Application.ScreenUpdating = False
Dim wdTbl As Table, wdCell As Cell, Rng1 As Range, Rng2 As Range
With ActiveDocument
  For Each wdTbl In .Tables
    For Each wdCell In wdTbl.Range.Cells
      Set Rng1 = wdCell.Range
      Rng1.End = Rng1.End - 1
      If Rng1.Font.Bold = True Then
        Set Rng2 = wdCell.Next.Range
        Rng2.End = Rng2.End - 1
        Select Case Rng1.Text
          Case "Name": Rng2.InsertBefore "<name>": Rng2.InsertAfter "</name>"
          Case "ID.": Rng2.InsertBefore "<ID>": Rng2.InsertAfter "</ID>"
          Case Else
        End Select
      End If
    Next
  Next
End With
Application.ScreenUpdating = True
End Sub