Copiar datos por macros de un libro a otro

Necesito realizar una copia de datos de un libro a otro mediante macros.

Mi libro de destino es un libro que almacena la copia de la base de datos de otro libro, y me genera un informe.

Mi libro de origen, es variable, quiero decir que tiene nombre variable. Necesito copiar 4 celdas puntualmente ( C1, D1, C2 y C3) y luego un rango de celdas que comienza desde el D49 hasta el IX, donde ese X me indica que es de una cantidad variable de filas (cosa que también quiero que me detecte que se copie hasta las celdas activas)

2 Respuestas

Respuesta
2

Entiendo lo siguiente:

1. Tienes un libro "destino", este libro va a contener la macro. ¿Correcto?

2. Con la macro, ¿te parece que se abra una ventana y selecciones el libro "origen" Correcto?

3. Vamos a tomar 4 celdas ( C1, D1, C2 y C3) y un rango (D49:Ixxxx). ¿Correcto?

Pero no pusiste en dónde se tiene que poner la información.

Además necesito que me digas:

4. Del libro "origen" cuál hoja es la que contiene la información.?

5. Y en el libro destino, dime en cuál hoja se va a pegar y a partir de cuáles celdas.?

Los puntos 1, 2 y 3, la respuestas es si. 

Punto 4: el libro contiene solo una hoja, y es esta la que me entrega los datos

Punto 5: el nombre es "Base de Datos" y es pegada del rango de datos es del B2 (en la longitud del rango dije que era desde el D49, pero es desde el A49) y la pegada específica de las celdas puntuales son AP4:AP7

Te anexo la macro para que la pruebes.

Sub CopiarDatos()
'Por.Dante Amor
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Base de Datos")
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Seleccione archivo de excel"
        .Filters.Clear
        .Filters.Add "All Files", "*.*"
        .Filters.Add "xls.*", "*.xls*"
        .FilterIndex = 2
        .AllowMultiSelect = False
        .InitialFileName = l1.Path
        '.Show
        If .Show Then
            Application.ScreenUpdating = False
            Set l2 = Workbooks.Open(.SelectedItems.Item(1))
            Set h2 = l2.ActiveSheet
            h2.Range("A49:I" & h2.Range("A" & Rows.Count).End(xlUp).Row).Copy
            h1.Range("B2").PasteSpecial Paste:=xlPasteValues
            h1.[AP4] = h2.[C1]
            h1.[AP5] = h2.[D1]
            h1.[AP6] = h2.[C2]
            h1.[AP7] = h2.[C3]
            l2.Close False
            Application.ScreenUpdating = True
        End If
    End With
    MsgBox "Copia terminada", vbInformation
End Sub

Sigue las Instrucciones para un botón y ejecutar la macro

  1. Abre tu libro 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. Ahora para crear un botón, puedes hacer lo siguiente:
  6. Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
  7. Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
  8. Una vez que insertaste la imagen en tu hoja, dale click derecho dentro de la imagen y selecciona: Tamaño y Propiedades. En la ventana que se abre selecciona la pestaña: Propiedades. Desmarca la opción “Imprimir Objeto”. Presiona “Cerrar”
  9. Vuelve a presionar click derecho dentro de la imagen y ahora selecciona: Asignar macro. Selecciona: CopiarDatos
  10. Aceptar.
  11. Para ejecutarla dale click a la imagen.

Saludos. Dante Amor

Te anexo la macro para copiar la información de archivos DATA, temporalmente te va a poner en las celdas AP4, AP5, AP6, AP7 la información de

Product Name:
Product Name:
Dimension X:
Dimension Y:

El problema es que al momento de cargar la información no viene separada. Y no tengo el ejemplo para hacer la separación.

Sub CopiarDatos()
'Por.Dante Amor
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Base de Datos")
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Seleccione archivo Data"
        .Filters.Clear
        .Filters.Add "Todos los archivos", "*.*"
        .Filters.Add "Data", "*.dat*"
        .FilterIndex = 2
        .AllowMultiSelect = False
        .InitialFileName = l1.Path
        '.Show
        If .Show Then
            Application.ScreenUpdating = False
            Application.DisplayAlerts = False
            Set l2 = Workbooks.Open(.SelectedItems.Item(1))
            Set h2 = l2.ActiveSheet '
            '
            u = h2.Range("A" & Rows.Count).End(xlUp).Row
            h2.Range("A49:A" & u).TextToColumns Destination:=Range("A49"), DataType:=xlDelimited, _
                TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
                Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:=",", _
                FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
                Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), _
                Array(12, 1), Array(13, 1)), TrailingMinusNumbers:=True
            '
            h2.Range("A49:I" & u).Copy
            h1.Range("B2").PasteSpecial Paste:=xlPasteValues
            h1.[AP4] = h2.[A1]
            h1.[AP5] = h2.[A1]
            h1.[AP6] = h2.[A2]
            h1.[AP7] = h2.[A3]
            l2.Close False
            Application.ScreenUpdating = True
        End If
    End With
    MsgBox "Copia terminada", vbInformation
End Sub
Respuesta
2

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas