Your code is only touching the first cell in a row. You need a loop there if you want to touch every cell in a row. For example
Code:
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