Sub InsertTableTags()

Dim tbl As Table
Dim rng As Range
Dim row As row

' Loop through all tables in the document
For Each tbl In ActiveDocument.Tables
    Set rng = tbl.Range

    ' Check if all columns are merged
    If tbl.Rows(2).Cells.Count > 1 Then
        ' Insert <TC> in first row
        rng.Cells(1).Range.InsertBefore Text:="<TC>"
        
    End If

    ' Loop through rows in the table
    For Each row In tbl.Rows
        Set rng = row.Range

        ' Check if current row is the second row
        If row.Index = 2 Then
            ' Check if all columns are merged
            If tbl.Rows(2).Cells.Count > 1 Then
                ' Insert <TCH> in second row
                rng.Cells(1).Range.InsertBefore Text:="<TCH>"
            End If
        ' Check if current row is not the first or last row
        ElseIf row.Index > 2 And row.Index < tbl.Rows.Count Then
            ' Insert <TT> in all cells
            rng.Cells(1).Range.InsertBefore Text:="<TT>"
        ' Check if current row is the last row
        ElseIf row.Index = tbl.Rows.Count Then
            ' Check if all columns are merged
            If tbl.Rows(tbl.Rows.Count).Cells.Count > 1 Then
                ' Insert <TTL> in last row
                rng.Cells(1).Range.InsertBefore Text:="<TTL>"
            End If

            ' Check if "Source", "Notes", or "Note" is found in the last row
            If InStr(rng.Text, "Source") > 0 Or InStr(rng.Text, "Notes") > 0 Or InStr(rng.Text, "Note") > 0 Then
                ' Insert <TTS> in all cells of the last row
                rng.Cells(1).Range.InsertBefore Text:="<TTS>"
            End If
        End If
    Next row
Next tbl

End Sub

Sub InsertTableTags()
  Dim tbl As Table, rng As Range, row As row, aCell As Cell
  
  ' Loop through all tables in the document
  For Each tbl In ActiveDocument.Tables
    Set rng = tbl.Range
    If tbl.Rows(2).Cells.Count > 1 Then    ' Check if all columns are merged
      rng.Cells(1).Range.InsertBefore Text:="<TC>"        ' Insert <TC> in first row
    End If
  
    ' Loop through rows in the table
    For Each row In tbl.Rows
      Set rng = row.Range
      If row.Index = 2 Then   ' Check if current row is the second row
        If tbl.Rows(2).Cells.Count > 1 Then     ' Check if all columns are merged
          rng.Cells(1).Range.InsertBefore Text:="<TCH>" ' Insert <TCH> in second row
        End If
   
      ElseIf row.Index > 2 And row.Index < tbl.Rows.Count Then   ' Check if current row is not the first or last row
        For Each aCell In row.Cells
          aCell.Range.InsertBefore Text:="<TT>"    ' Insert <TT> in all cells
        Next aCell
   
      ElseIf row.Index = tbl.Rows.Count Then   ' Check if current row is the last row
        If tbl.Rows(tbl.Rows.Count).Cells.Count > 1 Then     ' Check if all columns are merged
          rng.Cells(1).Range.InsertBefore Text:="<TTL>"        ' Insert <TTL> in last row
        End If
      
        ' Check if "Source", "Notes", or "Note" is found in the last row
        If InStr(rng.Text, "Source") > 0 Or InStr(rng.Text, "Notes") > 0 Or InStr(rng.Text, "Note") > 0 Then
          rng.Cells(1).Range.InsertBefore Text:="<TTS>"    ' Insert <TTS> in all cells of the last row
        End If
      End If
    Next row
  Next tbl
End Sub

Sub InsertTableTags()
  Dim tbl As Table, aCell As Cell
  Dim iRow As Integer, iCol As Integer, iRows As Integer
  
  ' Loop through all tables in the document
  For Each tbl In ActiveDocument.Tables
    iRows = tbl.Rows.Count
    For Each aCell In tbl.Range.Cells
      iRow = aCell.RowIndex
      iCol = aCell.ColumnIndex
      Debug.Print iRow, iCol, aCell.Range.Words(1)
      Select Case iRow
        Case 1
          'do nothing
        Case 2
          'If aCell.Next.RowIndex <= iRow Then    'not sure if you want to manage merged
            aCell.Range.InsertBefore Text:="<TC>"
          'End If
        Case iRows    'last row only
          If aCell.Range.Text Like "*Source*" Or aCell.Range.Text Like "*Note*" Then
            aCell.Range.InsertBefore Text:="<TTS>"
          Else
            aCell.Range.InsertBefore Text:="<TTL>"
          End If
        Case Else  'not first, second or last row
          aCell.Range.InsertBefore Text:="<TT>"
      End Select
    Next aCell
  Next tbl
End Sub