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)
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
Hola, Tengo una duda al respecto, a ver si me podrías echar una mano.Estoy haciendo una macro parecida, pero en mi caso, debo copiar dos rangos de dos libros diferentes y pegarlos en el libro de destino, uno a continuación del otro.Mi problema es que el primer rango, la última fila es desconocida (ya que me va variando). ¿Cómo puedo ponerlo para que el segundo rango me lo pegue después del primero sin conocer en qué fila acaba este?Un saludo - Asdf Laica