Copiar y pegar un rango de datos de un archivo excel "Origen" a otro archivo excel "Destino" e ir almacenando los datos
Espero me puedan ayudar, tengo el siguiente código en el cual me pasa los datos de mis columnas (archivo Origen) 2,3,4,5,6 (archivo Origen) a otro Excel (archivo Destino) donde debo ir acumulando los datos cada día, haciendo clic al botón enviar.
El problema con el código es que me pasa todos los datos de las columnas 2,3,4,5,6 (archivo Origen) ya que busca la última celda con valor en cada columna, lo que ocasiona que ponga datos de encabezado que tengo al inicio y me gustaría ver la posibilidad que solo copie y mande un rango definido, ejemplo:
I.-Solo quiero que copie y mande los datos de la fila 8 a la 9, excluyendo de la fila 1 a la 7.
II.- Al dar clic al botón enviar, del archivo Origen, copie los valores del rango B9:F17 y vaya al archivo Destino, donde busque la última celda vacío y pegue los valores del archivo origen y que se vayan almacenando cada que se dé clic al botón enviar.
III.- El problema de este código es que pasa los valores que contiene toda la columna desde la fila 1 a la 7 y me gustaría que fuera solo por un rango definido (B9:F17) y no como en la imagen.
2 Respuestas
Ho la solrak9
Visita:
Excel y Macros
La clave está en encontrar la última fila con datos de la columna que tiene datos, en este caso la hoja con los datos, es la columna B, entonces necesitas algo como esto:
.Range("B" & Rows. Count).End(3). RowPrueba la siguiente macro, ajusta los nombres de las hojas Hoja1 (origen) y Hoja2 (destino)
Sub copiar()
Dim lr As Long
Application.ScreenUpdating = False
With Sheets("Hoja1")
.Range("B9:F" & .Range("B" & Rows.Count).End(3).Row).Copy
End With
With Sheets("Hoja2")
lr = .Range("D" & Rows.Count).End(3).Row + 1
.Range("D" & lr).PasteSpecial xlPasteAll
'para poner la fecha en la columna A
.Range("A" & lr & ":A" & .Range("D" & Rows.Count).End(3).Row).Value = Date
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End SubMás sobre macros:
https://m.youtube.com/watch?v=PupmVvM16-8&t=847s
https://m.youtube.com/watch?v=PupmVvM16-8&t=849s
Sal u dos
Dante Amor
Con gusto te ayudaría con tu consulta pero no dejaste el código.
Seguramente allí se menciona toda la col o un rango diferente al que necesitas.
Aquí un ejemplo donde deberás ajustar el nombre de libro, hoja y columna destino.
x = wb2.Sheets(1).Range("B" & Rows.Count).End(xlUp).Row + 1
Range("B9:F17 ").Copy Destination:= wb. Sheets(1). Range("B" & x)Quedo a la espera de tu código si no puedes ajustar este ejemplo a tu libro.
También te recomiendo el video Nº 71 de mi canal: COPIAR y PEGAR.
Desde allí podrás encontrar el enlace para descargar el libro de ejemplo con todas las diferentes opciones de pegado: con fórmula o no, con formato o no y otras opciones más.
Cierto, este es el código que utilizo:
Sub copiar()
Dim Ruta As String
Dim libro_que_envia As Workbook, libro_que_recibe As Workbook
Dim HOJA_QUE_ENVIA, HOJA_QUE_RECIBE As Object
Dim RUTAS As String
Dim FILA, FINAL, FILA2, FINAL2, I2 As Long
Set libroOrigen = ThisWorkbook
Ruta = "C:\Acumulado.xlsm"
If Ruta = "false" Then
Exit Sub
End If
Set libroDestino = Workbooks.Open(Ruta)
RUTAS = Ruta
Application.ScreenUpdating = False
'libro del que extrae la informacion
Set libro_que_envia = ThisWorkbook
Set HOJA_QUE_ENVIA = libro_que_envia.Sheets(1)
'libro donde se ingresa informacion
Set libro_que_recibe = Workbooks.Open(RUTAS)
Set HOJA_QUE_RECIBE = libro_que_recibe.Sheets(1)
FILA = HOJA_QUE_ENVIA.Range("B" & Rows.Count).End(xlUp).Row + 1
FINAL = FILA - 1
'Busco la ultima celda de la columna D que contiene datos y agrega una celda para pegar los valores
FILA2 = HOJA_QUE_RECIBE.Range("D" & Rows.Count).End(xlUp).Row + 1
FINAL2 = FILA2 - 1
For I2 = 2 To FINAL 'Selecciona la columna 2
' copia y pega los valores de origen al archivo acumulado
HOJA_QUE_RECIBE.Cells(FILA2, 4) = HOJA_QUE_ENVIA.Cells(I2, 2)
HOJA_QUE_RECIBE.Cells(FILA2, 5) = HOJA_QUE_ENVIA.Cells(I2, 3)
HOJA_QUE_RECIBE.Cells(FILA2, 6) = HOJA_QUE_ENVIA.Cells(I2, 4)
HOJA_QUE_RECIBE.Cells(FILA2, 7) = HOJA_QUE_ENVIA.Cells(I2, 5)
HOJA_QUE_RECIBE.Cells(FILA2, 8) = HOJA_QUE_ENVIA.Cells(I2, 6)
FILA2 = FILA2 + 1
Next I2
End Sub
Estás pasando fila por fila a partir de I2 = 2. Pero según tu imagen debiera ser 9.
For I2 = 9 To FINAL 'Selecciona la columna 2 'I2 debiera ser la primera fila de tu rango, o sea 9
Y la última del rango la estás obteniendo bien, aunque no hace falta sumarle 1 ni tampoco utilizar 2 variables, por lo que la dejaría así:
FINAL = HOJA_QUE_ENVIA.Range("B" & Rows.Count).End(xlUp).Row
Algunos usuarios utilizan esta otra que es lo mismo:
Range("B" & Rows. Count).End(3). RowTu código quedaría entonces algo reducido:
'obtener la última fila del rango origen
FINAL = HOJA_QUE_ENVIA.Range("B" & Rows.Count).End(xlUp).Row
'Busco la ultima celda de la columna D que contiene datos y agrega una celda para pegar los valores
FILA2 = HOJA_QUE_RECIBE.Range("D" & Rows.Count).End(xlUp).Row + 1
For I2 = 9 To FINAL 'Selecciona la columna 2 'I2 debiera ser la primera fila de tu rango, o sea 9
' copia y pega los valores de origen al archivo acumulado
HOJA_QUE_RECIBE.Cells(FILA2, 4) = HOJA_QUE_ENVIA.Cells(I2, 2)
HOJA_QUE_RECIBE.Cells(FILA2, 5) = HOJA_QUE_ENVIA.Cells(I2, 3)
HOJA_QUE_RECIBE.Cells(FILA2, 6) = HOJA_QUE_ENVIA.Cells(I2, 4)
HOJA_QUE_RECIBE.Cells(FILA2, 7) = HOJA_QUE_ENVIA.Cells(I2, 5)
HOJA_QUE_RECIBE.Cells(FILA2, 8) = HOJA_QUE_ENVIA.Cells(I2, 6)
FILA2 = FILA2 + 1
Next I2
End SubIgual no dejes de revisar los ejemplos que te mencioné. Si no tiene fórmulas quizás podrías pasar todo el rango de una, sin necesidad del bucle For, de este modo:
HOJA_QUE_ENVIA.Range("B9:F" & FINAL).Copy Destination:=HOJA_QUE_RECIBE.Cells(FILA2, 4)Sdos!