
Copiar tres columnas de la celda a g y k hasta el último registro que contenga datos
Me puedes ayudar con una macro que ejecute la copia de las columnas A2 G2 y K2 a otro libro que se encuenta en la misma ruta sin abrirlo. Libro destino libro2 hoja2.
1. En la columna A2 copiar hasta el último registro que tenga datos. Dado que tengo 5 separación de filas vacías.
2.- En la columna -G2 copiar hasta uno antes del último registro con datos. También tengo 5 separaciones.
3.- En la columna k copiar de K2 a la última celda con datos.
1 Respuesta

Me puedes decir, la columna A en cuál celda inicial se va a pegar, ¿la G en cuál y la K en cuál?

Te anexo la macro, cambia "libro2 destino.xlsx", por el nombre del libro con todo y extensión. Cambia "Hoja2" por la hoja destino.
La macro está preparada para pegar en la misma columna empezando en la fila 2, si quieres que se pegue en la siguiente fila disponible, entonces borra esta línea de la macro:
u = 2
Sub CopiarColumnas() 'Por.Dante Amor Application.DisplayAlerts = False Application.ScreenUpdating = False Set l1 = ThisWorkbook Set h1 = l1.ActiveSheet Set l2 = Workbooks.Open(l1.Path & "\" & "libro2 destino.xlsx") Set h2 = l2.Sheets("Hoja2") ' cols = Array("A", "G", "K") ' For c = LBound(cols) To UBound(cols) f = 2 Do While h1.Cells(f, cols(c)) <> "" f = f + 1 Loop ' u = h2.Range(cols(c) & Rows.Count).End(xlUp).Row + 1 u = 2 h1.Range(cols(c) & "2:" & cols(c) & f).Copy h2.Cells(u, cols(c)) Next l2.Close True MsgBox "Copia terminada" End Sub
S a l u d o s . D a n t e A m o r
Recuerda valorar la respuesta.

La columna A en la columna A2 pegar como valores
La columna G en la columna C2 pegar como valores
La columna K en la columna G2 pegar como valores
Muchas gracias Dante

Te cambio la macro para pegar como valores
Sub CopiarColumnas() 'Por.Dante Amor Application.DisplayAlerts = False Application.ScreenUpdating = False Set l1 = ThisWorkbook Set h1 = l1.ActiveSheet Set l2 = Workbooks.Open(l1.Path & "\" & "libro2 destino.xlsx") Set h2 = l2.Sheets("Hoja2") ' cols = Array("A", "G", "K") ' For c = LBound(cols) To UBound(cols) f = 2 Do While h1.Cells(f, cols(c)) <> "" f = f + 1 Loop ' u = h2.Range(cols(c) & Rows.Count).End(xlUp).Row + 1 u = 2 h1.Range(cols(c) & "2:" & cols(c) & f).Copy h2.Cells(u, cols(c)).PasteSpecial Paste:=xlValues Next l2.Close True MsgBox "Copia terminada" End Sub
S a l u d o s . D a n t e A m o r
Recuerda valorar la respuesta.

Dante no funciona, copia a la solo encabezados.
quiero copia Columna Q y pegar en A2
Columna J pegar en C2
Columna P pegar en G2
por favor

Tu pregunta original es de A2 a A2, de G2 a G2 y K2 a K2
Ahora estás poniendo otras columnas, puedes ser más claro

la columna J debe de pegar todos los últimos registros menos uno esdecir
12
22
12
90
solo debe de copiar
12
22
12
por favor

No me estás explicando con claridad.
Qué columna copio y en qué columna la pego.
Y ahora tampoco entiendo qué datos debo copiar

Puedes poner unas imágenes con colores y me dices qué tengo que copiar y en dónde lo tengo que pegar
Pon 2 imágenes, una imagen de los datos origen
Y otra imagen con los datos ya pegados, para que pueda entender

Disculpe caballero, no hice el cuestionamiento correcto
Me puedes ayudar con una macro que ejecute la copia de las columnas Q2 J2 y P2 a otro libro que se encuentra en la misma ruta sin abrirlo. Libro - destino libro2 hoja2
1. En la columna Q2 copiar hasta el último registro que tenga, pegar en valores en la hoja2 apartir de la Columna A2
2.- En la columna -J2 copiar hasta uno antes del último registro con datos, es decir (HASTA EL PENULTIMO). Pegar en valores en la hoja 2 apartir de la celda C2
3.- En la columna k copiar de P2 a la última registro que tenga datos, pegar en valores en la hoja2 apartir de la celda G2.

El punto 3 todavía está confuso.
Prueba con la siguiente macro y me comentas
Sub CopiarColumnas() 'Por.Dante Amor Application.DisplayAlerts = False Application.ScreenUpdating = False Set l1 = ThisWorkbook Set h1 = l1.ActiveSheet Set l2 = Workbooks.Open(l1.Path & "\" & "libro2 destino.xlsx") Set h2 = l2.Sheets("Hoja2") ' cols = Array("Q", "J", "P") dest = Array("A", "C", "G") ' For c = LBound(cols) To UBound(cols) f = 2 Do While h1.Cells(f, cols(c)) <> "" f = f + 1 Loop ' u = h2.Range(cols(c) & Rows.Count).End(xlUp).Row + 1 u = 2 h1.Range(cols(c) & "2:" & cols(c) & f).Copy h2.Cells(u, dest(c)).PasteSpecial Paste:=xlValues Next l2.Close True MsgBox "Copia terminada" End Sub

Cabellero, solo me copia los encabezados

Es que no entiendo cómo tienes los datos.
No sé en dónde tienes datos y en dónde tienes filas vacías.
Pon las imágenes

Claro caballero adjunto

La macro copia todos los datos.
Pero todavía no entiendo en dónde los quieres pegar.
¿Quieres qué se empiecen a pegar a partir de la fila 2 o que se peguen al final?
Si borras la información de tu "libro2 destino" y ejecutas la macro, verás que te está copiando la información a partir de la fila 2.
Te anexo la misma macro, no le he hecho cambios, prueba nuevamente.
Sub CopiarColumnas() 'Por.Dante Amor Application.DisplayAlerts = False Application.ScreenUpdating = False Set l1 = ThisWorkbook Set h1 = l1.ActiveSheet Set l2 = Workbooks.Open(l1.Path & "\" & "libro2 destino.xlsx") Set h2 = l2.Sheets("Hoja2") ' cols = Array("Q", "J", "P") dest = Array("A", "C", "G") ' For c = LBound(cols) To UBound(cols) f = 2 Do While h1.Cells(f, cols(c)) <> "" f = f + 1 Loop ' u = h2.Range(cols(c) & Rows.Count).End(xlUp).Row + 1 u = 2 h1.Range(cols(c) & "2:" & cols(c) & f).Copy h2.Cells(u, dest(c)).PasteSpecial Paste:=xlValues Next l2.Close True MsgBox "Copia terminada" End Sub

Efectivamente ya funciona, pero cuando hace la copia de la columna C quiero hasta el penúltimo registro. y ahorita me copia hasta el ultimo registro.
La columna A y G correctas.
Me apoyas con este detalle

La macro siempre funcionó, como te comenté, ¿no le hice cambios . De acuerdo?
Te anexo una nueva versión para que te copie hasta la penúltima fila de la columna origen "J" a la columna destino "C".
Sub CopiarColumnas() 'Por.Dante Amor Application.DisplayAlerts = False Application.ScreenUpdating = False Set l1 = ThisWorkbook Set h1 = l1.ActiveSheet Set l2 = Workbooks.Open(l1.Path & "\" & "libro2 destino.xlsx") Set h2 = l2.Sheets("Hoja2") ' cols = Array("Q", "J", "P") dest = Array("A", "C", "G") ' For c = LBound(cols) To UBound(cols) f = 2 Do While h1.Cells(f, cols(c)) <> "" f = f + 1 Loop ' f = f - 1 If f > 1 Then If cols(c) = "J" Then f = f - 1 End If u = h2.Range(cols(c) & Rows.Count).End(xlUp).Row + 1 u = 2 h1.Range(cols(c) & "2:" & cols(c) & f).Copy h2.Cells(u, dest(c)).PasteSpecial Paste:=xlValues End If Next l2.Close True MsgBox "Copia terminada" End Sub
S a l u d o s . D a n t e A m o r
Recuerda valorar la respuesta.
- Compartir respuesta
