Consolidar varias hojas de distintos libros en una sola hoja
Tengo en una carpeta muchos archivos Excel con la misma estructura. Me gustaría copiar la segunda hoja (se llama "Detalle gastos") de cada libro y pegarla (solo valores) en una hoja de un libro nuevo.
El rango de datos es fijo: las columnas son siempre las mismas y están en el mismo orden (Desde la columna A hasta la columna L); las filas que quiero copiar son desde la fila 6 hasta la fila 40
En la carpeta donde están guardados estos archivos hay subcarpetas con archivos que también quiero incluir en la macro si es posible. Si no es posible copiare la macro en cada una de las carpetas.
1 Respuesta
1. Leo el primer archivo, selecciono la hoja "detalle gastos", copio los datos del rango A6 a L40 y los pego en un libro nuevo en una hoja nueva, primera duda, en cuál celda inicio el pegado, ¿en A1 o en A6?
2. Leo el segundo archivo, selecciono la hoja "detalle gastos", copio los datos del rango A6 a L40 y los pego, en:
Opción a) En el mismo libro, en la misma hoja donde pegué los datos del primer archivo, ¿después de los datos del primer archivo?
Opción b) En el mismo libro, ¿pero en una hoja nueva?
Opción c) ¿Creo un nuevo libro y en una nueva hoja pego los datos?
3. ¿Cómo se va a llamar el nuevo o los nuevos archivos?
4. ¿En dónde voy a guardar el nuevo archivo?
1. Copias los datos en a2. En la primera fila hay un titulo
2.opción a
3. El nuevo archivo se va a llamar liquidaciones total
4. El nuevo archivo va a estar en la misma carpeta que los demás archivos
Te anexo la macro para que la pongas en un libro nuevo y guardes el libro en la misma carpeta en donde tienes los archivos a consolidar.
Sub ConsolidarHojas()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set l2 = Workbooks.Add
Set h2 = l2.Sheets(1)
'
ruta = l1.Path & "\"
arch = Dir(ruta & "*.xls*")
nuevo = "liquidaciones total.xlsx"
j = 2
'
Do While arch <> ""
If arch <> l1.Name And arch <> nuevo Then
Set l3 = Workbooks.Open(ruta & arch)
existe = False
For Each h In l3.Sheets
If h.Name = "Detalle gastos" Then
existe = True
Exit For
End If
Next
If existe Then
Set h3 = l3.Sheets("Detalle gastos")
h3.Range("A6:L40").Copy
h2.Cells(j, "A").PasteSpecial Paste:=xlValues
j = j + 36
End If
l3.Close False
End If
arch = Dir()
Loop
'
l2.SaveAs ruta & nuevo
l2.Close
MsgBox "Terminado"
End SubS a l u d o s . D a n t e A m o r
Recuerda valorar la respuesta.
