Copiar el mismo rango de diferentes hojas de varios archivos a un nuevo archivo excel
Quisiera saber como puedo copiar en un libro en blanco o en el libro donde esta mi macro, un mismo rango de diferentes archivos.
Ejemplo: rango ("a2:d3"); .. La hoja en todos los archivos se llama correspondencia, los archivos están guardados en una misma carpeta(facturas),, pero dentro de la carpeta puede cambiar el numero de archivos.
Quiero colocar los rangos obtenidos de los diferentes archivos, uno sobre otro dejando una fila de por medio.. Esta operación se puede realizar a partir de la fila 2 con el fin de colocar mis encabezados manuakmente.
1 Respuesta
Te anexo la macro
Sub ActualizarLibro()
'Por.Dante Amor
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets.Add
nom = l1.Name
ruta = l1.Path & "\"
ChDir ruta
archi = Dir("*.xls*")
'
Do While archi <> ""
If archi <> l1.Name Then
Set l2 = Workbooks.Open(archi)
'Rows(1).Copy h1.[A1]
u = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row + 2
Range([a2], [a2].SpecialCells(11)).Copy h1.Range("A" & u)
l2.Close False
archi = Dir()
End If
Loop
Application.ScreenUpdating = True
MsgBox "libros copiados", vbInformation
End SubPon la macro en el archivo nuevo y guardar el archivo en la misma carpeta donde tienes los demás archivos.
Saludos. Dante Amor
Buen día Dante:
Gracias por tu colaboración, efectivamente la macro funciona copiando todo el contenido de los demás archivos, pero por ahora lo que necesito es que copie el mismo rango de todos los archivos. Este rango esta en todos los archivos en una hoja con el mismo nombre
Ejemplo Rango (a2:d3") (de todos los archivos), la hoja se llama igual en todos los archivos (Correspondencia)
Un saludo
Tienes razón, pediste un rango, te cambio la macro:
Sub ActualizarLibro()
'Por.Dante Amor
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets.Add
nom = l1.Name
ruta = l1.Path & "\"
ChDir ruta
archi = Dir("*.xls*")
'
Do While archi <> ""
If archi <> l1.Name Then
Set l2 = Workbooks.Open(archi)
'Rows(1).Copy h1.[A1]
u = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row + 2
Range("a2:d3").Copy h1.Range("A" & u)
l2.Close False
archi = Dir()
End If
Loop
Application.ScreenUpdating = True
MsgBox "libros copiados", vbInformation
End SubSaludos.Dante Amor
Recuerda valorar la respuesta.
Gracias Dante,
La macro toma el rango pero de todas las hojas de los libros, quisiera que tomara el rango pero unicamente de la hoja "facturacion" la cual esta en todos los archivos con el mismo nombre.
Mil gracias
Disculpa nuevamente, la macro copia el rango, no de todas las hojas, solamente de la hoja activa, pero puede ser que la hoja activa no sea la de "facturacion", pero ya actualicé esa parte, prueba con esta macro:
Sub ActualizarLibro()
'Por.Dante Amor
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = l1.Sheets.Add
nom = l1.Name
ruta = l1.Path & "\"
ChDir ruta
archi = Dir("*.xls*")
'
Do While archi <> ""
If archi <> l1.Name Then
Set l2 = Workbooks.Open(archi)
'on error resume next
u = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row + 2
Sheets("facturacion").Range("a2:d3").Copy h1.Range("A" & u)
On Error GoTo 0
l2.Close False
archi = Dir()
End If
Loop
Application.ScreenUpdating = True
MsgBox "libros copiados", vbInformation
End Sub
