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

Respuesta
1

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.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas