Necessitaria de mais detalhes, o ideal seria postar um modelo reduzido ou detalhar melhor
mas já pensou em utilizar o Gravador de Macros e o Recurso Localizar / Substituir.

[]s

Mauro,

Segue um exemplo. Veja se está claro.

Obrigado pela a ajuda desde já.

Poderia usar a função substituir, mas levaria muito tempo.

Não sei o que vc pretende, mas, tem mesmo que ser via VBA?

Abaixo segue um exemplo com fórmulas.

Abs

Tentei expandir o intervalos...mas não está funcionando. Deveria funcionar, não?

Porque a formula abaixo (com intervalo maior) nao funciona ?

=SE(SOMARPRODUTO(--(NÚM.CARACT(F2)-NÚM.CARACT(SUBSTITUIR(F2;$A$2:$A$25033;""))>0))=0;"";INDIRETO("$A"&SOMARPRODUTO((NÚM.CARACT(F2)-NÚM.CARACT(SUBSTITUIR(F2;$A$2:$A$25033;""))>0)*LIN($A$2:$A$25033))))

Não entendi, deveria funcionar.

Bem, segue um código (bem básico, da pra dar uma melhorada):

Sub excluir_GT()
Application.ScreenUpdating = False

Dim i               As Long
Dim j               As Long
Dim UL              As Long
Dim c(1 To 2)       As Long
Dim palavras()      As String
Dim temp(1 To 2)    As String
Dim busca           As Range

Set busca = Range("B2:B21")

UL = Cells(Rows.Count, "G").End(xlUp).Row

i = 1
j = busca.Cells.Count

ReDim palavras(1 To j)

For Each cell In busca
    palavras(i) = cell.Value2
    i = i + 1
Next cell

For i = 2 To UL
    temp(1) = Cells(i, "G").Value2
    For j = 1 To UBound(palavras())
        c(1) = Len(temp(1))
        c(2) = Len(Replace(temp(1), palavras(j), ""))
        If c(1) > c(2) Then temp(2) = temp(2) & " " & palavras(j)
    Next j
    If Len(temp(2)) > 0 Then temp(2) = Right(temp(2), Len(temp(2)) - 1)
    Cells(i, "G").Value2 = temp(2)
Next i

Application.ScreenUpdating = True
End Sub

Não está funcionando.

segue o arquivo original. Por favor, veja se consegue adaptar sua macro ou fórmula para esses dados

Vai me ajudar bastante!