4

a1 b2 c3a2 b4 c6a3 b6 c9a4 b8 c12 g a4 b8 c12 ga5 b10 c15 a14 b28 c42a6 b12 c18 a24 b48 c72a7 b14 c21a8 b16 c24a9 b18 c27a10 b20 c30a11 b22 c33a12 b24 c36a13 b26 c39a14 b28 c42a15 b30 c45a16 b32 c48a17 b34 c51a18 b36 c54a19 b38 c57a20 b40 c60 3a21 b42 c63a22 b44 c66a23 b46 c69a24 b48 c72

Sub Buscar_Texto_En_Lista() 'dimensionesDim lngUltimaFila As LongDim strObjetoBuscar As StringDim lngResultado As LongDim lngColumna As Long, lngFila As LongDim lngPegarColumna As Long, lngPegarFila As LongDim x As Integer, n As Integer 'quitar resultados anterioresRange("G5:H4000").ClearContents 'columna + fila donde empezar/terminar búsquedalngColumna = 1lngFila = 1lngUltimaFila = Columns(lngColumna).Range("A65536").End(xlUp).Row 'columna donde empezar a pegar resultados 5=ElngPegarColumna = 5'fila donde pega resultadolngPegarFila = 4 'celda donde escribo lo que quiero buscarstrObjetoBuscar = Range("sheet1! G2").TextIf strObjetoBuscar = "" Then GoTo 99'minúsculasstrObjetoBuscar = LCase(strObjetoBuscar) 'bucle: realizar búsquedaFor n = lngFila To lngUltimaFila 'evaluación 1° columna de busqueda 2°celda de busqueda de donde empieza a buscar lngResultado = InStr(1, Cells(n, 1), strObjetoBuscar, vbTextCompare) 'copiar/pegar If lngResultado > 0 Then Range(Cells(n, 1), Cells(n, 2)).Copy Range( _ Cells(lngPegarFila, lngPegarColumna), _ Cells(lngPegarFila, lngPegarColumna + 2)) _ .Select ActiveSheet.Paste lngPegarFila = lngPegarFila + 1 End If Next n

99:00:00End Sub