Función InSTR entre dos libros

Tengo un archivo llamado "prueba.xlsm" desde donde ejecuto una macro para que busque por términos en otro libro llamado "1315 - 2.xlsm", utilizando la función InSTR.

Cuando ejecuto el código en el mismo libro y hoja, funciona excelente, pero no logro hacer lo mismo cuando consulto el otro libro y que me devuelva los datos en el primero.

El código es una adaptación de lo que encontré en la web, ya que aunque he avanzado en el autoaprendizaje de VBA, es la primera vez que uso esta función, que encadenaré a un proyecto mayor que tengo ya el 85% terminado.

Agradeceré la ayuda que puedan brindarme!!!

Aquí está el código:

Sub Buscar_Texto_En_Lista()

Application.ScreenUpdating = False
Dim lngUltimaFila As Long Dim strObjetoBuscar As String

Dim lngResultado As Long Dim

lngColumna As Long, lngFila As Long

Dim lngPegarColumna As Long, lngPegarFila As Long

Dim x As Integer, n As Integer

'quitar resultados anteriores

Range("G5:I4000").ClearContents

'columna + fila donde empezar/terminar búsqueda
Windows("1315 - 2.XLS").Activate
lngColumna = 1 lngFila = 2 lngUltimaFila = Columns(lngColumna).Range("A10000").End(xlUp).Row

'columna + fila donde empezar a pegar resultados
lngPegarColumna = 7 lngPegarFila = 5

Windows("prueba.xlsm").Activate

'objeto a buscar

strObjetoBuscar = Range("G2").Text

If strObjetoBuscar = "" Then GoTo 99

'minúsculas strObjetoBuscar = LCase(strObjetoBuscar)

'bucle: realizar búsqueda

Windows("1315 - 2.XLS").Activate

For n = lngFila To lngUltimaFila

'evaluación lngResultado = InStr(1, Cells(n, 1), strObjetoBuscar, vbTextCompare) 'copiar/pegar

If lngResultado > 0 Then

Windows("1315 - 2.xlsm").Range(Cells(n, 1), Cells(n, 3)).Copy

Range(Cells(lngPegarFila, lngPegarColumna), _ Cells(lngPegarFila, lngPegarColumna + 2)).Select

Windows("prueba.xlsm").Paste lngPegarFila = lngPegarFila + 1 End If Next n

'Desactivar selection

Application.CutCopyMode = False

Windows("PRUEBA.XLSM").Activate

Range("G2").Select

99:

Application.ScreenUpdating = True
End Sub

1 respuesta

Respuesta
1

Te regreso la macro actualizada

Sub Buscar_Texto_En_Lista()
Application.ScreenUpdating = False
Dim lngUltimaFila As Long
Dim strObjetoBuscar As String
Dim lngResultado As Long
Dim lngColumna As Long, lngFila As Long
Dim lngPegarColumna As Long, lngPegarFila As Long
Dim x As Integer, n As Integer
'quitar resultados anteriores
 Range("G5:I4000").ClearContents
'columna + fila donde empezar/terminar búsqueda
Workbooks("1315 - 2").Activate
lngColumna = 1
lngFila = 2
lngUltimaFila = Columns(lngColumna).Range("A10000").End(xlUp).Row
'columna + fila donde empezar a pegar resultados
lngPegarColumna = 7
lngPegarFila = 5
    Workbooks("prueba.xlsm").Activate
    hoja = ActiveSheet.Name
'objeto a buscar
strObjetoBuscar = Range("G2").Text
If strObjetoBuscar = "" Then GoTo 99
 'minúsculas strObjetoBuscar = LCase(strObjetoBuscar)
'bucle: realizar búsqueda
Workbooks("1315 - 2.XLSx").Activate
For n = lngFila To lngUltimaFila
    'evaluación
    LngResultado = InStr(1, Cells(n, 1), strObjetoBuscar, vbTextCompare) 'copiar/pegar
    If lngResultado > 0 Then
        Workbooks("1315 - 2"). ActiveSheet.Range(Cells(n, 1), Cells(n, 3)).Copy _
            Workbooks("prueba"). Sheets(hoja). Cells(lngPegarFila, lngPegarColumna)
        'Range(Cells(lngPegarFila, lngPegarColumna), _
        Cells(lngPegarFila, lngPegarColumna + 2)).Select
        lngPegarFila = lngPegarFila + 1
     End If
 Next n
'Desactivar selection
Application.CutCopyMode = False
Workbooks("PRUEBA.XLSM").Activate
Range("G2").Select
99:
    Application.ScreenUpdating = True
End Sub

Saludos. DAM
Si es lo que necesitas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Macros para buscar cadena de texto

Estoy haciendo una macros para buscar datos de una columna y después pegar toda la fila a otra celda, todo dentro de la misma hoja, quiero modificar el código para que el resultado lo pegue en otra hoja pero no me resulta, por favor si alguien me...
1 respuesta

Ejecutar macro según el valor de la celda

Que tal necesito de su valiosa ayuda tengo que ejecutar una macro en automático esto depende del valor de la celda. Estoy utilizando la siguiente macro: Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address = "$S$1" And...
1 respuesta

Combinar dos rangos de celdas

Hice algo para combinar dos rangos de celdas, pero hay algo que no funciona. Sub combinarceldas() Range("D20:E35500").Select Selection.Merge End Sub En definitiva lo que necesito en combinar los rangos "D20:D35500 y E20:E35500" y no tener que...
1 respuesta

Crear cronometro excel 2010

He estado intentando crear una macro para cronometrar con excel y no lo consigo, lo que necesitaría sería el cronometro en si, que cuando le de a un botón comience, con otro botón pare y con otro resetee a "0". También estoy intentando poner una...
1 respuesta

Seleccionar rangos discontinuos...

Expertos", al menos más que yo seguro, me considero que siempre estoy aprendiendo, je je... Llevo tiempo viendo el foro y por fin me he decidido a registrarme, con una gran duda, a ver si alguien me la saber resolver, al menos un poco... Tengo una...
1 respuesta

Crear controles en ejecución

Como puedo crear en Access un control (una caja de texto) en ejecución con visual basic en un formulario.
1 respuesta

Crear una Dll con Vb6.0

Quiero crear una dll con vb y que pueda ser llamada desde otros programas. Tengo el código compilado y la dll creada pero cuando la llamo desde vb u otro programa me da el siguiente error: "no se puede encontrar el punto de entrada de la DLL xxxx"...
1 respuesta