Consolidar varias hojas de un libro
Saludos a todos
Solicito su apoyo para crear una macro para realizar lo siguiente
Tengo un libro de excel con varias hojas y cada mes se agregan más hojas
Tengo una hoja llamada ÚNICOS donde tengo el Num, nombre completo de personas, puesto, depto, fecha ingreso y fecha salida todos los títulos están en A1, B1, C1, D1, E1, F1
Todas las hojas empiezas los datos de la fila 4 hasta n filas y de la columna A hasta la columna AE, y en la columna B se encuentran los nombres de las personas
La macro recorre cada celda de la hoja únicos columna A2 hasta la A400 y busca en cada hoja columna B el nombre de la persona, si lo encuentra copia los datos en la hoja consolidado, pueden repetirse los nombres de las personas
La hoja consolidado debe quedar de la siguiente manera (las primeras 6 columnas vienen de la hoja Únicos, columna G el nombre de la hoja donde se toman los datos, los siguientes son datos de las hojas varias columna C a la AE, en caso de que no se encuentre el nombre de la persona poner No existen datos a mostrar
Num Nombre Puesto Depto F_Inicial F_final Hoja SD Sueldo Primas Otros
12A Juan Perez Chófer Ruta 01-04-2007 15-08-2014 Ene-1 100.00 1000.23 345.12 25.00
Ene-2 100.00 1600.00 0.00 0.00
Febr-1 100.00 1500.00 134 13.00
G123 Petra Domis Caz Ventas 03-01-1999 vacío Ene-1 120.00 1800.00 0.00 0.00
No existen datos a mostrar
Febr-1 150.00 2250 0.00 234.12
Agradezco de antemano su ayuda y comentarios
Saludos
1 respuesta
Esta es la macro.
Cambia en la macro en esta parte por los nombre de tus hojas
Set h1 = Sheets("UNICOS")
Set h2 = Sheets("consolidado")
Si en tu hoja "unicos", los nombres tienen más o menos filas que la 400, entonces cambia en la macro el 400 por esto h1.Range("B" & Rows. Count).End(xlUp). Row, de esta forma leerá todos los que estén en la columna "B" sin importar en qué fila tengas al último.
Sub consolidar()
'Por.DAM
Application.ScreenUpdating = False
Set h1 = Sheets("UNICOS")
Set h2 = Sheets("consolidado")
'
h2.Cells.ClearContents
h1.Range("A1:F1").Copy h2.Range("A1")
'
For i = 2 To 400
u = h2.Range("G" & Rows.Count).End(xlUp).Row + 1
h1.Range("A" & i & ":F" & i).Copy h2.Range("A" & u)
For Each h In Sheets
Select Case UCase(h.Name)
Case UCase("UNICOS"), UCase("CONSOLIDADO")
Case Else
h2.Range("G" & 1) = "Hoja"
h.Range("C" & 3 & ":AE" & 3).Copy h2.Range("H" & 1)
Set b = h.Range("B:B").Find(h1.Cells(i, "B"))
If Not b Is Nothing Then
h2.Range("G" & u) = h.Name
h.Range("C" & b.Row & ":AE" & b.Row).Copy
h2.Range("H" & u).PasteSpecial Paste:=xlValues
Else
h2.Range("G" & u) = "No existen datos a mostrar"
End If
u = u + 1
End Select
Next
Next
End SubSaludos.Dante Amor
Recuerda valorar la respuesta.
