Sub AddCaptionText()
Dim Tbl As Table, RngCell As Range, RngRef As Range, StrTxt As String
For Each Tbl In ActiveDocument.Tables
  Set RngCell = Tbl.Range.Cells(Tbl.Range.Cells.Count).Range
  With RngCell
    .End = .End - 1
    .Collapse wdCollapseEnd
    If .Style = "Caption" Then
      Set RngRef = .Paragraphs.Last.Next.Next.Range
      With RngRef
        .End = .End - 1
        If .Fields.Count = 1 Then
          If .Fields(1).Type = wdFieldIndexEntry Then
            StrTxt = Trim(Replace(Replace(.Fields(1).Code.Text, "XE ", _
              vbNullString, , , vbTextCompare), Chr(34), ""))
            With RngCell
              .Text = ": " & StrTxt
              .Collapse wdCollapseEnd
              .FormattedText = RngRef.FormattedText
            End With
            .Paragraphs.First.Range.Delete
          End If
        End If
      End With
    End If
  End With
Next
End Sub