Macro para copiar y pegar de un libro a otro
Necesito una macro que copie todos los datos (variables) de una hoja del libro 1 y los pegue tras la útlma fila ocupada en otra hoja pero del libro 2
1 respuesta
La siguiente macro te ayuda a seleccionar el "libro1" que contiene la información a copiar, después de seleccionar el libro, la macro copia todos los datos y los pega en la última fila del "libro2".
- El libro2 deberá contener la macro.
- Deberás ejecutar la macro en la hoja en la que quieres que se pegue la información.
- Cambia en la macro esto: "hojalibro1", por el nombre real de la hoja del libro1 que quieras copiar.
Sub abrearchivo()
'Por.Dante Amor
hoja = "hojalibro1"
'
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
ruta = ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo de excel"
.Filters.Clear
.Filters.Add "Todos", "*.*"
.Filters.Add "Archivo xls", "*.xls*"
.FilterIndex = 2
.AllowMultiSelect = False
.InitialFileName = ruta
'.Show
If .Show Then
arch = .SelectedItems.Item(1)
Set l2 = Workbooks.Open(arch)
u = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row + 1
l2.Sheets(hoja).UsedRange.Copy h1.Range("A" & u)
l2.Close False
End If
End With
End SubSaludos.Dante Amor
Recuerda valorar la respuesta.
Hola Dante:
Muchas gracias, funciona perfectamente, sin embargo lo que no había dicho es que copiase desde la fila A3, ya que las otras dos son encabezados y no me interesa que los copie debido a que son hasta 15 hojas diferentes y no me interesa el encabezado.
De nuevo muchas gracias. David Leonet
Te anexo la macro con el cambio
Sub abrearchivo()
'Por.Dante Amor
hoja = "hojalibro1"
'
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
ruta = ThisWorkbook.Path
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Seleccione archivo de excel"
.Filters.Clear
.Filters.Add "Todos", "*.*"
.Filters.Add "Archivo xls", "*.xls*"
.FilterIndex = 2
.AllowMultiSelect = False
.InitialFileName = ruta
'.Show
If .Show Then
arch = .SelectedItems.Item(1)
Set l2 = Workbooks.Open(arch)
Set h2 = l2.Sheets(hoja)
ce = h2.UsedRange.SpecialCells(11).Address
u = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row + 1
h2.Range("A3", ce).Copy h1.Range("A" & u)
l2.Close False
End If
End With
End SubSaludos.Dante Amor
Recuerda valorar la respuesta.
