Seleccionar palabras específica de una celda definida en otra, y proyectar el resultado en una tercera

Ejecuta la siguiente macro

Sub Buscar_Palabras()
'Por Dante Amor
'
'Seleccionar palabras específica de una celda definida en otra,
'y proyectar el resultado en una tercera
'
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        Set r = Columns("B")
        Set b = r.Find(Cells(i, "A"), LookAt:=xlPart)
        If Not b Is Nothing Then
            celda = b.Address
            Do
                Cells(b.Row, "C").Value = Cells(i, "A")
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> celda
        End If
    Next
    MsgBox "Fin"
End Sub

Sigue las Instrucciones para un botón y ejecutar la macro

1. Abre tu libro de Excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Ahora para crear un botón, puedes hacer lo siguiente:
6. Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
7. Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
8. Una vez que insertaste la imagen en tu hoja, dale click derecho dentro de la imagen y selecciona: Tamaño y Propiedades. En la ventana que se abre selecciona la pestaña: Propiedades. Desmarca la opción “Imprimir Objeto”. Presiona “Cerrar”
9. Vuelve a presionar click derecho dentro de la imagen y ahora selecciona: Asignar macro. Selecciona: Buscar_Palabras
10. Aceptar.
11. Para ejecutarla dale click a la imagen.

[Si te ayudó la información, no olvides valorar la respuesta.

¡De escándalo! ¡Muchas gracias!

Cuando ejecuto columnas de 2000 celdas en A y 600 en columna B, se me queda pillado el Excel bastante tiempo, llegando a no terminar después de una hora, teniendo un ordenador i7 de 32GB de RAM. ¿Es porque son muchas celdas? Porque no veo en la macro nada que limite el número de celdas no?

Un saludo y gracias

Ya hice una prueba con 2200 en columna A y 755 en columna B y se tarda 4 segundos.

Prueba con esta macro:

Sub Buscar_Palabras()
'Por Dante Amor
'
'Seleccionar palabras específica de una celda definida en otra,
'y proyectar el resultado en una tercera
'
    Application.ScreenUpdating = False
    ua = Range("A" & Rows.Count).End(xlUp).Row
    ub = Range("B" & Rows.Count).End(xlUp).Row
    For i = 2 To ua
        Set r = Range("B2:B" & ub)
        Set b = r.Find(Cells(i, "A").Value, LookAt:=xlPart)
        If Not b Is Nothing Then
            celda = b.Address
            Do
                Cells(b.Row, "C").Value = Cells(i, "A").Value
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> celda
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

[sal u dos

¿Tienes otras aplicaciones abiertas?

¿Tienes más hojas en ese archivo de excel?

¿Tienes fórmulas o formatos en es archivo de excel?

Prueba la última macro en un archivo nuevo en una sola hoja y pones tus columnas A y B.

Revisa que después de tu último dato de la columna A no tengas espacios en blanco, es decir, tu última celda de la columna A debe ser la A2000

Ahora si que va como un tiro! ¡Muchas Gracias! 

Buenas tardes, que tal? 

En relación a la consulta anterior, no me muestra el resultado correcto para celdas elevada información, como es el caso de las imágenes. En la columna C donde va HONOR 8 (Imagen 1), debería ir HONOR 8X 128GB, que si se fija están dentro de la lista donde se obtiene como se ve en la Imagen 2. ¿Tiene algún límite dentro de la celda? 

Imagen 1

Imagen 2