Macro para copiar datos de varios libros y pegarlos en un libro nuevo en la primera hoja.
Que magnifica comunidad; gracias a todos.
Mi pregunta es si hay alguna manera de copiar la información de un rango de la hoja1 de varios libros y pegarla en un libro nuevo pero en la primera hoja; lo complicado para mi es que no son rangos fijos, es decir que cada libro en su primera hoja tiene un cúmulo y rango de datos distinto. Debe existir alguna manera para que se identifique el rango donde hay datos en esa hoja de "x" libro, copiar ese rango y pegarlo consecutivamente en el libro nuevo pero en la primera hoja, espero no haber sido tan redundante y haber sido claro.
La macro funciona perfectamente. Muchas gracias! Yo necesito hacer que siempre me pegue desde la primera posición pero manteniendo el formato de la hoja destino, es decir, si necesito que la información siempre se pegue a partir de la celda A2, ¿cómo puedo incluir eso en la macro sin borrar el formato ya descrito? Además, necesito esta misma macro pero que pueda buscar dentro de sub-carpetas, porque no todos los archivos estarán organizados dentro de la misma. ¿Sería posible tenerla?
2 respuestas más de otros expertos
Sigue las Instrucciones para ejecutar la macro
1. Abre tu hoja de excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Para ejecutarla presiona F5
Sub libros()
'Lee archivos del directorio y Copia la hoja 1
'Por.Dam
Application.ScreenUpdating = False
ruta = ThisWorkbook.Path
ChDir ruta
archi = Dir("*.xls*")
Set h1 = ThisWorkbook.Sheets("hoja1")
On Error Resume Next
Do While archi <> ""
If InStr(1, archi, "nuevo") = 0 Then
Workbooks.Open archi
If Err.Number = 0 Then
Sheets(1).Select
Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Copy _
h1.Range("A" & h1.Range("A1").SpecialCells(xlLastCell).Row + 1)
Else
Err.Number = 0
End If
Application.DisplayAlerts = False
Workbooks(archi).Close
Application.DisplayAlerts = True
End If
archi = Dir()
Loop
End SubIndicaciones:
1. Deberás tener el libro con la macro y los demás libros en la misma carpeta
2. El libro con la macro deberás ponerle el nombre de “nuevo”
3. Te copia los datos de la hoja 1 de cada libro que se encuentre en el mimo directorio
Saludos. Dam
Si es lo que necesitas.
Funciona perfecto, muchas gracias es lo que buscaba, solo tengo una duda, que puedo hacer o que linea debo modificar para que cada vez que ejecute la macro, empiece a pegar desde la parte superior de la hoja es decir desde la primera fila.
De antemano gracias por haberme ayudado.
Utiliza la siguiente macro
Sub libros()
'Lee archivos del directorio y Copia la hoja 1
'Por.Dam
Application.ScreenUpdating = False
ruta = ThisWorkbook.Path
ChDir ruta
archi = Dir("*.xls*")
Set h1 = ThisWorkbook.Sheets("hoja1")
h1.Cells.Clear
On Error Resume Next
ffin = h1.UsedRange.Find(what:="*").Row
ActiveCell.SpecialCells(xlLastCell).Select
On Error Resume Next
Do While archi <> ""
If InStr(1, archi, "nuevo") = 0 Then
Workbooks.Open archi
If Err.Number = 0 Then
Sheets(1).Select
Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Copy _
h1.Range("A" & h1.Range("A1").SpecialCells(xlLastCell).Row + 1)
End If
Err.Number = 0
Application.DisplayAlerts = False
Workbooks(archi).Close
Application.DisplayAlerts = True
End If
archi = Dir()
Loop
End Sub Saludos.Dam
Si es lo que necesitas.
me pone subscript out of range en esta linea Set h1 = ThisWorkbook.Sheets("Sheet1")Set h1 = ThisWorkbook.Sheets("Sheet1")
¿
¿Sabrás por que? Mi excel esta en ingles por eso le cambie a "Sheet1"