Necesito macro en un libro que busque datos en otros libros y me indique en cual de los libros se encuentra

Necesito buscar códigos de documentos de otros libros que se encuentren en una carpeta especifica, la carpeta tiene 15 libros excel y estos códigos se ingresan en al menos dos de ellos y cada libro tiene 2 hojas "carga y rendición", eso quiere decir que se pueden ingresar en 4 hojas por ejemplo: "el dato 1234 esta en el libro carganexo en la hoja carga y rendicion rango B8:B20000" pero también puede estar en el libro "0001_luisgonzalez hoja carga y rendicion rango B8:B20000" como muestra la imagen:

Yo cree un formulario con un textbox donde ingreso el dato a buscar, y abajo de el tengo un listbox la cual quiero que me aparezca el dato encontrado el libro y hoja en donde se encuentra, y que finalmente inserte tal cual como lo muestra la imagen, en la hoja excel.

El boton buscar esta unido al textbox, solo quiero que los datos que yo ingrese en el textbox coincida con un dato que exista en los otros libros y los indique en el listbox copiandolos en la hoja excel buscar libro buscardoc.xls, y si el dato ingresado no está en ningún libro, me de un mensaje "documento no está asignado"

el libro se llama buscardoc.xls

la direccion de la carpeta es: D:\correo\

Y los libros excel son:

carganexo.xls

0001.xls

0002.xls

.

.

0014.xls

Si se pudiera hacer y si no, algo que sea mas o menos igual.

1 Respuesta

Respuesta
1

H o l a:

Te anexo la macro 

Private Sub CommandButton1_Click()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    If TextBox1 = "" Then Exit Sub
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Buscar")
    ruta = "D:\correo\"
    ruta = "C:\trabajo\"
    arch = Dir(ruta & "*.xls*")
    exis = False
    ListBox1.Clear
    Do While arch <> ""
        Set l2 = Workbooks.Open(ruta & arch, ReadOnly = True)
        For Each h In l2.Sheets
            Set b = h.Columns("B").Find(TextBox1, lookat:=xlWhole)
            If Not b Is Nothing Then
                exis = True
                ListBox1.AddItem TextBox1
                ListBox1.List(ListBox1.ListCount - 1, 1) = arch
                ListBox1.List(ListBox1.ListCount - 1, 2) = h.Name
                u = h1.Range("C" & Rows.Count).End(xlUp).Row + 1
                h1.Cells(u, "C") = TextBox1
                h1.Cells(u, "D") = arch
                h1.Cells(u, "E") = h.Name
            End If
        Next
        l2.Close
        arch = Dir()
    Loop
    '
    Application.ScreenUpdating = True
    If exis = False Then
        MsgBox "documento no está asignado"
    End If
End Sub

Hola gracias por la ayuda, pero no me funciona, puedo enviarte mi carpeta con los archivos para que lo veas ? 

Muchas Gracias!!!

Quita esta línea de la macro:

ruta = "C:\trabajo\"

Prueba nuevamente, si tienes problemas envíame tu archivo con la macro.

También me dices qué es lo que no te funciona o qué mensaje de error te aparece.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas