Buscar un dato de un libro a otro y me regrese el nombre de la hoja

Buscar el dato en excel. En otro libro y me regrese el nombre de la hoja donde esta el resultado. Buscando de un libro a otro. Me regrese mediante una formula

1 Respuesta

Respuesta
1

.04/11/16

Buenas, Rosy

Prueba con la siguiente rutina que asume que sólo tienes -en la sesión actual de MS Excel- el archivo donde dejar el nombre de la hoja y el archivo donde buscar el dato.

Desde luego deberás indicarle la dirección de una celda donde está el dato a buscar y en qué celda dejar el resultado. Desde luego, esto no puede hacerse mediante una fórmula.

Accede al Editor de VBA (Atajo: Alt + F11), allí inserta un módulo (Insertar-Módulo) y pega el siguiente código:

Sub TraeHoja()
'---- Variables modificables ----
'=== ROSY, modifica estos datos de acuerdo a tu proyecto:
DatoBuscar = "B2" 'Celda donde está el dato a buscar
CeldaResultado = "C2" 'Celda donde dejar el nombre de la página
Parcial = False 'False = Coincidencia Total - True = Encontrar parte del texto de Dato a Buscar
'---- fin Variables
'
'---- inicio de rutina:
'  
L_Destino = ActiveWorkbook.Name
HojaDest = ActiveSheet.Name
Buscar = Range(DatoBuscar).Value
Application.ScreenUpdating = False
On Error Resume Next
    ActiveWindow.ActivateNext
If Err.Number = 0 Then
    Err.Clear
    On Error GoTo 0
    L_Origen = ActiveWorkbook.Name
    dire = ""
    TipoCoinc = IIf(Parcial, xlPart, xlWhole)
        For Each LaHoja In Sheets
            LaHoja.Select
            On Error Resume Next
            dire = Cells.Find(What:=Buscar, LookAt:=TipoCoinc).Address(False, False)
            If Len(dire) > 1 Then Exit For
            On Error GoTo 0
        Next
        Windows(L_Destino).Activate
        Sheets(HojaDest).Select
        If Len(dire) Then
            Range(CeldaResultado).Value = "Hoja: " & LaHoja.Name & "- Celda: " & dire
        Else
            Range(CeldaResultado).Value = ">>> NO Encontrado"
        End If
Else
    Err.Clear
    On Error GoTo 0
    ElTitulo = "NO HAY OTRO ARCHIVO"
    ElMensaje = "No se encontró archivo pra buscar dato" & Chr(10) & "El procedimiento se detiene aquí" & _
        Chr(10) & "Lola!, NO MODIFICO NADA" & Chr(10) & "Abrir el archivo de Busqueda y disparar esta rutina nuevamente"
    TipoMSG = vbOKOnly + vbExclamation
    MsgBox ElMensaje, TipoMSG, ElTitulo
End If
End Sub

También hay una variable para que indiques si la coincidencia debe ser total o parcial.

Pruebala y dime si te funcionó.

Muy buen fin de semana.

Fer

.

Gracia fernando.. funciona muy bien. Solo que lo hace en una celda tendría que ver como se hace en toda una columna

.

Hola, Rosy

Y si. Era un escenario posible, aunque no lo hayas mencionado en tu pregunta original

Esta variante de la rutina anterior ejecuta la búsqueda para la lista que tengas en la columna B dejando el dato en C. Es decir que mantendremos las dos variables anteriores, pero ahora indican la primera celda donde está el dato a buscar y la primera donde dejar la hoja donde encuentre el dato (if any). Reemplaza la anterior por esta:

Sub TraeHoja()
'---- Variables modificables ----
'=== ROSY, modifica estos datos de acuerdo a tu proyecto:
DatoBuscar = "B2" 'Celda donde está el PRIMER dato a buscar
CeldaResultado = "C2" 'Celda donde dejar el PRIMER nombre de la página
Parcial = False 'False = Coincidencia Total - True = Encontrar parte del texto de Dato a Buscar
'---- fin Variables
'
'---- inicio de rutina:
'  
cont = 0
LaFila = 0
UltFila = ActiveSheet.Range(Left(DatoBuscar, 1) & Rows.Count).End(xlUp).Address
L_Destino = ActiveWorkbook.Name
HojaDest = ActiveSheet.Name
TipoCoinc = IIf(Parcial, xlPart, xlWhole)
Buscar = Range(DatoBuscar).Value
Application.ScreenUpdating = False
On Error Resume Next
    ActiveWindow.ActivateNext
If Err.Number = 0 Then
    Set DESTINO = Workbooks(L_Destino).Sheets(HojaDest)
    Err.Clear
    On Error GoTo 0
    L_Origen = ActiveWorkbook.Name
    Do While Range(DatoBuscar).Offset(LaFila).Address <= UltFila
        dire = ""
        Buscar = DESTINO.Range(DatoBuscar).Offset(LaFila).Value
            For Each LaHoja In Sheets
                LaHoja.Select
                On Error Resume Next
                dire = Cells.Find(What:=Buscar, LookAt:=TipoCoinc).Address(False, False)
                If Len(dire) > 1 Then Exit For
                On Error GoTo 0
            Next
            If Len(dire) Then
                DESTINO.Range(CeldaResultado).Offset(LaFila).Value = "Hoja: " & LaHoja.Name & "- Celda: " & dire
                ContOK = ContOK + 1
            Else
                DESTINO.Range(CeldaResultado).Offset(LaFila).Value = ">>> NO Encontrado"
            End If
        LaFila = LaFila + 1
        cont = cont + 1
    Loop
    Windows(L_Destino).Activate
    Sheets(HojaDest).Select
    Range(DatoBuscar).Select
    ElMensaje = IIf(cont = 0, "NO SE BUSCÓ DATO ALGUNO", "Se buscaron: " & cont & " linea" & IIf(cont > 1, "s", "") & Chr(10) & "Encontrando " & ContOK & " caso" & IIf(ContOK > 1, "s", ""))
    TipoMens = IIf(cont = 0, vbCritical, vbInformation)
    ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
    Application.ScreenUpdating = True
    MsgBox ElMensaje, TipoMens, ElTitulo
    Set DESTINO = Nothing
Else
    Err.Clear
    On Error GoTo 0
    ElTitulo = "NO HAY OTRO ARCHIVO"
    ElMensaje = "No se encontró archivo pra buscar dato" & Chr(10) & "El procedimiento se detiene aquí" & _
        Chr(10) & "Lola!, NO MODIFICO NADA" & Chr(10) & "Abrir el archivo de Busqueda y disparar esta rutina nuevamente"
    TipoMSG = vbOKOnly + vbExclamation
    MsgBox ElMensaje, TipoMSG, ElTitulo
End If
End Sub

Espero que te funcione OK.

Saludos
Fer

.

Gracias fernando. Justamente lo que estaba buscando.. se queda en la fila 5. Se finaliza cuando ya no encuentra el dato?

.

Hola, Rosy

De acuerdo a la celda que le hayas indicado donde empiece a buscar considera la última celda que tenga dato. Controla si tu celda inicial es B2, o cámbiala por la que corresponda a tu listado.

Si no encuentra el dato, deja en la columna que le haya indicado ">>>No Enocntrado" y sigue con la siguiente.

Luego me comentas si corrigiendo la celda inicial se resolvió tu problema.

Saludos

Fer

.

Si mi celdas son a2 y el resultado g2. Ya hice el cambio.. y tengo por ejemplo... 600 fiilas si lo busca bien hasta la 5

.

Y luego de la fila 5 ¿Qué hace? ¿Se detiene? ¿O coloca NO Encontrado?

¿Qué hay en la fila 6?

¿Podrías pegar -aqui- una imagen parcial de ese listado?

Aparte, recuerda colocar si Parcial = False (Coincidencia completa de lo que tengas en A) o Parcial = True (Basta que encuentre el texto de A en un fragmento de alguna celda del otro libro).

¡Gracias! en la fila 5 ya no hace nada. Se pone blanco. No aparece mensaje como si terminara la rutina.

.

Extraño, Rosy

En cualquier caso, debería llegar a un mensaje personalizado, donde la rutina te avisa qué hizo.

A menos que la celda A5 tenga una fórmula que dé ERROR no encuentro razón para que la macro se detenga sin aviso alguno.

Insisto, ¿Puedes colocar aquí una imagen de ese listado?

Saludos

Fer

.

Disculpa fernando.. como incluyo la imagen?

.

Mmmm, creo que en este caso será más simple que me envíes ese archivo para que vea qué problema tiene . Simplemente escríbeme a:

Saludos

Fer

.

Gracias. Fernando.. te mande correo.

.

Ok, Rosy

Aquí te envío una variante de la rutina que debería funcionar OK en tu caso.

Reemplaza la anterior por esta:

Sub TraeHoja()
'---- Variables modificables ----
'=== ROSY, modifica estos datos de acuerdo a tu proyecto:
DatoBuscar = "A2" 'Celda donde está el PRIMER dato a buscar
CeldaResultado = "G2" 'Celda donde dejar el PRIMER nombre de la página
Parcial = False 'False = Coincidencia Total - True = Encontrar parte del texto de Dato a Buscar
'---- fin Variables
'
'---- inicio de rutina:
'  
cont = 0
LaFila = 0
UltFila = ActiveSheet.Range(Left(DatoBuscar, 1) & Rows.Count).End(xlUp).Offset(1).Address
L_Destino = ActiveWorkbook.Name
HojaDest = ActiveSheet.Name
TipoCoinc = IIf(Parcial, xlPart, xlWhole)
Buscar = Range(DatoBuscar).Value
On Error Resume Next
    ActiveWindow.ActivateNext
If Err.Number = 0 Then
    Application.ScreenUpdating = False
    Set DESTINO = Workbooks(L_Destino).Sheets(HojaDest)
    Err.Clear
    On Error GoTo 0
    L_Origen = ActiveWorkbook.Name
    Do While DESTINO.Range(DatoBuscar).Offset(LaFila).Address <> UltFila
        dire = ""
        Buscar = Len(DESTINO.Range(DatoBuscar).Offset(LaFila).Value)
        Buscar = IIf(Len(Buscar), Buscar, "Z34!ewe")
            For Each LaHoja In Sheets
                LaHoja.Select
                On Error Resume Next
                dire = Cells.Find(What:=Buscar, LookAt:=TipoCoinc).Address(False, False)
                If Len(dire) > 1 Then Exit For
                On Error GoTo 0
            Next
            If Len(dire) Then
                DESTINO.Range(CeldaResultado).Offset(LaFila).Value = "Hoja: " & LaHoja.Name & "- Celda: " & dire
                ContOK = ContOK + 1
            Else
                DESTINO.Range(CeldaResultado).Offset(LaFila).Value = ">>> NO Encontrado"
            End If
        LaFila = LaFila + 1
        cont = cont + 1
        TEST = DESTINO.Range(DatoBuscar).Offset(LaFila).Address
    Loop
    Windows(L_Destino).Activate
    Sheets(HojaDest).Select
    Range(DatoBuscar).Select
    ElMensaje = IIf(cont = 0, "NO SE BUSCÓ DATO ALGUNO", "Se buscaron: " & cont & " linea" & IIf(cont > 1, "s", "") & Chr(10) & "Encontrando " & ContOK & " caso" & IIf(ContOK > 1, "s", ""))
    TipoMens = IIf(cont = 0, vbCritical, vbInformation)
    ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
    Application.ScreenUpdating = True
    MsgBox ElMensaje, TipoMens, ElTitulo
    Set DESTINO = Nothing
Else
    Err.Clear
    On Error GoTo 0
    ElTitulo = "NO HAY OTRO ARCHIVO"
    ElMensaje = "No se encontró archivo pra buscar dato" & Chr(10) & "El procedimiento se detiene aquí" & _
        Chr(10) & "Lola!, NO MODIFICO NADA" & Chr(10) & "Abrir el archivo de Busqueda y disparar esta rutina nuevamente"
    TipoMSG = vbOKOnly + vbExclamation
    MsgBox ElMensaje, TipoMSG, ElTitulo
End If
End Sub

Pruebala y dime si te anduvo para todas las filas.

Saludos

Fer

.

Gracias fernando.. si busca todas las filas. Pero ahora me sale no encontrado..todo

.

Oops!

Cierto dejé un control que no debía cuando probaba la rutina.

Usa esta, por favor:

Sub TraeHoja()
'---- Variables modificables ----
'=== ROSY, modifica estos datos de acuerdo a tu proyecto:
DatoBuscar = "A2" 'Celda donde está el PRIMER dato a buscar
CeldaResultado = "G2" 'Celda donde dejar el PRIMER nombre de la página
Parcial = False 'False = Coincidencia Total - True = Encontrar parte del texto de Dato a Buscar
'---- fin Variables
'
'---- inicio de rutina:
'  
cont = 0
LaFila = 0
UltFila = ActiveSheet.Range(Left(DatoBuscar, 1) & Rows.Count).End(xlUp).Offset(1).Address
L_Destino = ActiveWorkbook.Name
HojaDest = ActiveSheet.Name
TipoCoinc = IIf(Parcial, xlPart, xlWhole)
Buscar = Range(DatoBuscar).Value
On Error Resume Next
    ActiveWindow.ActivateNext
If Err.Number = 0 Then
    Application.ScreenUpdating = False
    Set DESTINO = Workbooks(L_Destino).Sheets(HojaDest)
    Err.Clear
    On Error GoTo 0
    L_Origen = ActiveWorkbook.Name
    Do While DESTINO.Range(DatoBuscar).Offset(LaFila).Address <> UltFila
        dire = ""
        Buscar = DESTINO.Range(DatoBuscar).Offset(LaFila).Value
        Buscar = IIf(Len(Buscar), Buscar, "Z34!ewe")
            For Each LaHoja In Sheets
                LaHoja.Select
                On Error Resume Next
                dire = Cells.Find(What:=Buscar, LookAt:=TipoCoinc).Address(False, False)
                If Len(dire) > 1 Then Exit For
                On Error GoTo 0
            Next
            If Len(dire) Then
                DESTINO.Range(CeldaResultado).Offset(LaFila).Value = "Hoja: " & LaHoja.Name & "- Celda: " & dire
                ContOK = ContOK + 1
            Else
                DESTINO.Range(CeldaResultado).Offset(LaFila).Value = ">>> NO Encontrado"
            End If
        LaFila = LaFila + 1
        cont = cont + 1
        TEST = DESTINO.Range(DatoBuscar).Offset(LaFila).Address
    Loop
    Windows(L_Destino).Activate
    Sheets(HojaDest).Select
    Range(DatoBuscar).Select
    ElMensaje = IIf(cont = 0, "NO SE BUSCÓ DATO ALGUNO", "Se buscaron: " & cont & " linea" & IIf(cont > 1, "s", "") & Chr(10) & "Encontrando " & ContOK & " caso" & IIf(ContOK > 1, "s", ""))
    TipoMens = IIf(cont = 0, vbCritical, vbInformation)
    ElTitulo = IIf(cont = 0, "NO SE HIZO NADA", "TERMINADO!")
    Application.ScreenUpdating = True
    MsgBox ElMensaje, TipoMens, ElTitulo
    Set DESTINO = Nothing
Else
    Err.Clear
    On Error GoTo 0
    ElTitulo = "NO HAY OTRO ARCHIVO"
    ElMensaje = "No se encontró archivo pra buscar dato" & Chr(10) & "El procedimiento se detiene aquí" & _
        Chr(10) & "Lola!, NO MODIFICO NADA" & Chr(10) & "Abrir el archivo de Busqueda y disparar esta rutina nuevamente"
    TipoMSG = vbOKOnly + vbExclamation
    MsgBox ElMensaje, TipoMSG, ElTitulo
End If
End Sub

Recuerda, además, que la variable "Parcial" está seteada a False, con lo que intenta buscar el texto completo de lo que pusiste en la columna A. 

Saludos

Fer

.

¡Gracias!  ya quedo fernando.. excelente gracias por tu apoyo

.

Un placer, Rosy, como siempre.

Abrazo

Fer

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Ver distintas hojas de un mismo libro en distintas pantallas

¿Pues no sé si esto se podrá hacer? Una determinada hoja de un libro se puede ver en la pantalla 2 mientras el resto de hojas, del mismo libro, las veo en la pantalla 1...¿Se puede? Si es así, ¿Cómo?
1 respuesta

Macro eliminar filas con valor

Tengo esta macro que me elimina las filas cuando el valor es #N/D, pero me ha dejado de funcionar cuando el valor es #CALC! Me podéis echar una mano. Muchas gracias. Sub Borrar_Filas() Dim ultifila As Integer 'guardo la última fila utilizada en la...
2 respuestas

Encontrar datos no coincidentes excel

Sucede que tengo que comparar dos bases de datos y encontrar los elementos no coincidentes para analizar. Se puede hacer por fórmula pero necesito algo más optimizado. El otro problema es que los datos son más de 1.48.576 capacidad de líneas de...
2 respuestas

¿Cómo resolver num a letras en excel?

En un libro excel habilitado para macros al convertir números a letras, en lugar de aparecer el resultado esperado aparece el mensaje # ¿NOMBRE?.
2 respuestas

´No sé que fórmulas usar para resolverme el problema

La imagen no me la sube y tampoco veo como se sube un fichero, os intentaré explicar lo mejor que pueda mi problema. En una hoja Excel tengo hallados los pagos por formas de pago: SUMAR.SI(D1:D16;"Efectivo";B1:B16), y...
3 respuestas

¿Cómo ajustar texto automáticamente en celdas combinadas en Excel 2019?

Solicito amablemente su valiosa ayuda para ajustar automáticamente un rango de celdas de una columna, he intentado con la opción de ajuste autamático de filas, también con al opción de ajustar texto de la pestaña inicio e incluso con la siguiente...
1 respuesta

¿Cómo usar un excel con macros desde varios ordenadores?

A tod@s! Tengo una aplicación en excel para introducir datos y visualizarlos con diferentes formularios creados. Lo que quiero hacer es: 1 Que ese libro este alojado en un sitio común y que lo puedan abrir desde varios ordenadores. 2º Que se pueda...
3 respuestas

Error en macro al ejecutar el botón aceptar

Necesitaría la colaboración para resolver el error que sucede al ejecutar el botón aceptar Set mifila = Hoja2.ListObjects(1).ListRows.Add Lo que yo agregue solamente a la base fue una columna al inicio ("A") anteriormente se llamaba Tabla6 y yo ahora...
1 respuesta

Detectar cambios en tabla dinámica

Tengo una hoja donde se van actualizando datos mediante una tabla dinámica. ¿Cómo detecto cuando se producen cambios (sólo en la parte de la tabla dinámica) para ejecutar otra macro en la misma hoja?
1 respuesta

Macro con combinación de teclas

Acudo aquí buscando ayuda, ¿Cómo crear una macro que genere una combinación de teclas? NO se trata de asignar una macro a una combinación de teclas, es todo lo contrario. El problema radica en que tengo una macro que rellena ciertas celdas con...
1 respuesta