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

Respuesta
2

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 Sub

Saludos.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 Sub

Saludos.Dante Amor

Recuerda valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas