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
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 SubSigue las Instrucciones para un botón y ejecutar la macro
- Abre tu libro de Excel
- Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
- En el menú elige Insertar / Módulo
- En el panel del lado derecho copia la macro
- Ahora para crear un botón, puedes hacer lo siguiente:
- Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
- Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
- 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”
- Vuelve a presionar click derecho dentro de la imagen y ahora selecciona: Asignar macro. Selecciona: CopiarDatos
- Aceptar.
- 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