Modificar macro la cual compara dos campos en excel y extrae información.
Dante y Feliz año nuevo.
Necesito que me ayudes a modificar una macro que me creaste la cual busca una matricula especifica en una carpeta de facturas, Lo que deseo ahora es que busque una fecha especifica en las mismas facturas que están en la carpeta de factura. La fecha estará en la celda B5 donde estará la macro y buscara la celda N5 en las facturas que estarán en dicha carpeta.
Esta es la macro:
Sub BuscarMatriculas()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Hoja1")
'
If h1.[B5] = "" Then
MsgBox "Poner matrícula"
Exit Sub
End If
'
ruta = "D:\COLEGIO MARIA TERESA QUIDIELLO\CARPETA DE FACTURA\"
'ruta = l1.Path & "\"
arch = Dir(ruta & h1.[N2] & "*.xls*")
col = "IT"
Do While arch <> ""
Set N = h1.Columns(col).Find(arch, lookat:=xlWhole)
If N Is Nothing Then
Set l2 = Workbooks.Open(ruta & arch)
Set h2 = l2.Sheets(1)
u = 8
Do While h1.Cells(u, "N") <> ""
u = u + 1
Loop
h1.Cells(u, "E") = h2.[L13]
h1.Cells(u, "D") = h2.[H13]
h1.Cells(u, "C") = h2.[D13]
h1.Cells(u, "G") = h2.[D20]
h1.Cells(u, "I") = h2.[D18]
h1.Cells(u, col) = arch
l2.Close False
End If
arch = Dir()
Loop
Application.ScreenUpdating = True
End Sub
1 Respuesta
H o l a:
Cambia en esta línea de la macro N2 por N5 ; prueba y me comentas
arch = Dir(ruta & h1.[N2] & "*.xls*")
Si no es lo que necesitas, tendrás que explicarme con ejemplos o con imágenes lo que tienes y que hay que buscar y en dónde, etc, todo el detalle
S a l u d o s . D a n t e A m o r Si es lo que necesitas. Recuerda valorar la respuesta. G r a c i a s. :)
Ya lo hice, pero me extrae información de otro archivo con la fecha que no deseo.
Te voy a enviar por correo el archivo (A)donde deseo que la información aparezca y dos archivos(B) de ejemplo donde debe la macro buscar la fecha que tiene el archivo (A). Una ves que encuentre la misma fecha en dichas facturas, buscara las celdas que indico en la macro para extraer la información que necesito.
Pero la macro es para buscar archivos que tengan el nombre de archivo igual a lo que tienes en la celda N5.
¿Pero lo que tu quieres es que se busque en todos los archivos y revise la fecha que tiene cada archivo en la celda N5?
¿Podrías aclarar el punto?
Lo que deseo es que busque en todos los archivos de la carpeta de factura la fecha que esta en la celda B5 del archivo "caja chica" y cuan do la encuentre, haga la extracción de las informaciones que están en las otras celdas.
Vamos a aclarar el punto.
1. Tienes un archivo principal
2. En la hoja1 del archivo principal, en la celda B5 tienes una fechaX, ¿correcto?
3. Luego quieres que la macro abra todos los archivos
4. ¿En cada archivo hay que buscar la fechaX en cuál celda?
5. ¿Cuáles celdas hay que extraer y en dónde se van a poner?
Recuerda explicar todo con un ejemplo claro.
La macro va a buscar la fechaX en la celda N5 de los archivos (facturas) que estén en la carpeta de factura y la extracción es la que indica la macro al final, si te fijas. Lo que necesito es que la pongas a buscar la fecha que esta en la celda B5 del archivo (caja chica) en la celda N5 de los dos archivos que te envíe(A33-1 y A33-3) los cuales deben estar en una carpeta llamada (carpeta de factura) tal como muestra la dirección la macro arriba.
Te anexo la macro actualizada
Sub BuscarMatriculas()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets("Hoja1")
'
If h1.[B5] = "" Then
MsgBox "Poner matrícula"
Exit Sub
End If
'
ruta = "D:\COLEGIO MARIA TERESA QUIDIELLO\carpeta de factura\"
'ruta = l1.Path & "\archivos\"
arch = Dir(ruta & h1.[N5] & "*.xls*")
col = "IT"
Do While arch <> ""
If arch <> l1.Name Then
Set l2 = Workbooks.Open(ruta & arch)
Set h2 = l2.Sheets(1)
If h2.[N5] = h1.[B5] Then
u = 8
Do While h1.Cells(u, "D") <> ""
u = u + 1
Loop
h1.Cells(u, "E") = h2.[L13]
h1.Cells(u, "D") = h2.[H13]
h1.Cells(u, "C") = h2.[D13]
h1.Cells(u, "G") = h2.[D20]
h1.Cells(u, "I") = h2.[D18]
h1.Cells(u, col) = arch
End If
l2.Close False
End If
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub:) S aludos. D a n t e A m o r. Recuerda valorar la respuesta. G r a c i a s ;)
