Macro para aplicar Negrita en Texto Concatenado en Formato de Tabla

Código para Tabla(añadir nuevos datos)

Private Sub Worksheet_Change(ByVal Target As Range)

Dim t As ListObject, o As ListColumn, d As ListColumn, j As Range, g As Range, r As Long, e As ListColumn, c As Variant, n As Variant

Set t = Me.ListObjects("")

Set o = t.ListColumns("")

Set d = t.ListColumns("")

c = Array("")

If Intersect(Target, t.DataBodyRange) Is Nothing Then Exit Sub

Application.EnableEvents = False

d.DataBodyRange.Value = o.DataBodyRange.Value

d.DataBodyRange.Font.Bold = False

For Each g In d.DataBodyRange

For Each n In c

Set e = t.ListColumns(n)

For Each j In e.DataBodyRange

If j.Value <> "" Then

r = InStr(1, g.Value, j.Value, vbTextCompare)

If r > 0 Then

g.Characters(r, Len(j.Value)).Font.Bold = True

End If

Next j

Next n

Next g

Application.EnableEvents = True

End Sub