Adding the document to your original message rather than your latest message caused a momentary confusion, but based on that document the following will work
Code:
Sub Macro1()
Dim oTable As Table
Dim oCell As Cell
Dim oRng As Range
For Each oTable In ActiveDocument.Tables
For Each oCell In oTable.Range.Cells
Set oRng = oCell.Range
With oRng.Find
Do While .Execute(findText:="&")
If oRng.Font.Bold = True Then
If oRng.Font.ColorIndex = wdRed Or _
oRng.Font.ColorIndex = wdGreen Then
oRng.HighlightColorIndex = wdYellow
oCell.Shading.BackgroundPatternColor = &HD9E9FD
End If
End If
Exit Do
Loop
End With
Next oCell
Next oTable
Set oTable = Nothing
Set oCell = Nothing
Set oRng = Nothing
End Sub
I noted that one of the ampersands in the last row of the tables was not coloured red so that one is not processed. If you only want to process cells with bold ampersands regardless of colour, then remove the colour check e.g.
Code:
Sub Macro1()
Dim oTable As Table
Dim oCell As Cell
Dim oRng As Range
For Each oTable In ActiveDocument.Tables
For Each oCell In oTable.Range.Cells
Set oRng = oCell.Range
With oRng.Find
Do While .Execute(findText:="&")
If oRng.Font.Bold = True Then
oRng.HighlightColorIndex = wdYellow
oCell.Shading.BackgroundPatternColor = &HD9E9FD
End If
Exit Do
Loop
End With
Next oCell
Next oTable
Set oTable = Nothing
Set oCell = Nothing
Set oRng = Nothing
End Sub