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
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.
