Filtrar y hacer resumen en Excel
Dante buen día.
Requiero un favor para una macro en excel.
Tengo una carpeta con 100 archivos que tienen la misma estructura, es decir los mismos encabezados, y columnas, En la columna G a partir de la fila 14, debo filtrar por un texto " 49744 - DESARROLLAR PROCESOS COMUNICATIVOS EFICACES Y ASERTIVOS" y que me cuente cuantos "APROBADOS" y cuantos "POR EVALUAR" tiene ese filtro, "aprobados" y "por evaluar" están en la columna h.
Eso lo debe hacer en los 100 archivos y en una hoja resumen debe colocar el nombre del archivo que aparece en todos los archivos en la celda c4 y al frente cuantos aprobados y cuantos por evaluar.
Ejemplo:
Aprobados Por evaluar
Archivo1 4 0
ARCHIVO 2 3 2
Agradezco si me puede ayudar,
Cordial saludo,
Omar
1 Respuesta
Te anexo la macro para que la pongas en el archivo donde quieres el resumen
Cambia "C:\trabajo\libros\" por el nombre de la carpeta donde tienes tus 100 archivos.
No comentaste en cuál hoja están los datos, entonces la macro lee la primer hoja de cada archivo.
Revisa que los textos de los argumentos sean los que necesitas:
arg1 = "49744 - DESARROLLAR PROCESOS COMUNICATIVOS EFICACES Y ASERTIVOS"
arg2 = "APROBADO"
arg3 = "POR EVALUAR"
Sub Resumen()
'Por Dante Amor
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets(1)
'
h1.Range("C4:E" & Rows.Count).ClearContents
ruta = "C:\trabajo\libros\"
'
arch = Dir(ruta & "*.xls*")
arg1 = "49744 - DESARROLLAR PROCESOS COMUNICATIVOS EFICACES Y ASERTIVOS"
arg2 = "APROBADO"
arg3 = "POR EVALUAR"
fila = 4
Do While arch <> ""
Set l2 = Workbooks.Open(ruta & arch)
Set h2 = l2.Sheets(1)
u2 = h2.Range("G" & Rows.Count).End(xlUp).Row
aprob = WorksheetFunction.CountIfs(h2.Range("G14:G" & u2), arg1, _
h2.Range("H14:H" & u2), arg2)
porev = WorksheetFunction.CountIfs(h2.Range("G14:G" & u2), arg1, _
h2.Range("H14:H" & u2), arg3)
h1.Cells(fila, "C").Value = arch
h1.Cells(fila, "D").Value = aprob
h1.Cells(fila, "E").Value = porev
fila = fila + 1
'
l2.Close False
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Fin resumen"
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
