Como mejorar copiar y pegar de una tabla a otra

Para mi amigo Dante Amor

Por favor me podrías ayudar a mejorar esta macro, que copia los datos de una tabla a otra hoja de manera continua y discontinua, he visto muchos ejemplos pero con este código me funciono, pero se hace muy largo ya que toma datos de columna a columna. La idea es que si deseo copiar el registro de las columnas A:C y luego continuar copiado los datos de las columnas M:Q, luego saltar y copiar los registros de las columnas V:Z y por último tomar los datos de la columna "AB", siempre recorriendo hasta la última fila, todo lo anterior se vaya pegando en otra hoja. El código es el siguiente:

Sub pegadato()
Dim qRow As Long
qRow = Range([E10], Cells(Rows.Count, "E").End(xlUp)).Count
Sheets("Datos").[F6].Resize(qRow) = [E10].Resize(qRow).Value
qRow = Range([F10], Cells(Rows.Count, "F").End(xlUp)).Count
Sheets("Datos").[G6].Resize(qRow) = [F10].Resize(qRow).Value
qRow = Range([G10], Cells(Rows.Count, "G").End(xlUp)).Count
Sheets("Datos").[H6].Resize(qRow) = [G10].Resize(qRow).Value
qRow = Range([M10], Cells(Rows.Count, "M").End(xlUp)).Count
Sheets("Datos").[I6].Resize(qRow) = [M10].Resize(qRow).Value
qRow = Range([N10], Cells(Rows.Count, "N").End(xlUp)).Count
Sheets("Datos").[J6].Resize(qRow) = [N10].Resize(qRow).Value
qRow = Range([O10], Cells(Rows.Count, "O").End(xlUp)).Count
Sheets("Datos").[K6].Resize(qRow) = [O10].Resize(qRow).Value
qRow = Range([P10], Cells(Rows.Count, "P").End(xlUp)).Count
Sheets("Datos").[L6].Resize(qRow) = [P10].Resize(qRow).Value
qRow = Range([Q10], Cells(Rows.Count, "Q").End(xlUp)).Count
Sheets("Datos").[N6].Resize(qRow) = [Q10].Resize(qRow).Value
qRow = Range([V10], Cells(Rows.Count, "V").End(xlUp)).Count
Sheets("Datos").[O6].Resize(qRow) = [V10].Resize(qRow).Value
qRow = Range([W10], Cells(Rows.Count, "W").End(xlUp)).Count
Sheets("Datos").[P6].Resize(qRow) = [W10].Resize(qRow).Value
qRow = Range([X10], Cells(Rows.Count, "X").End(xlUp)).Count
Sheets("Datos").[Q6].Resize(qRow) = [X10].Resize(qRow).Value
qRow = Range([Y10], Cells(Rows.Count, "Y").End(xlUp)).Count
Sheets("Datos").[R6].Resize(qRow) = [Y10].Resize(qRow).Value
qRow = Range([Z10], Cells(Rows.Count, "Z").End(xlUp)).Count
Sheets("Datos").[S6].Resize(qRow) = [Z10].Resize(qRow).Value
qRow = Range([AB10], Cells(Rows.Count, "AB").End(xlUp)).Count
Sheets("Datos").[Y6].Resize(qRow) = [AB10].Resize(qRow).Value
End Sub

Para mejor ayuda te envió el archivo al correo

1

1 respuesta

Respuesta
1

Te anexo una opción

Sub pegadato()
    Application.ScreenUpdating = False
    u = Range("E" & Rows.Count).End(xlUp).Row
    Sheets("Liquidacion_Nomina").Range("E10:G" & u & ",M10:Q" & u & ",V10:Z" & u & ",AB10:AB" & u).Copy
    Sheets("Datos").Range("F6").PasteSpecial xlValues
    Application.CutCopyMode = False
End Sub

sal u dos

¡Gracias! 

Funciona perfecto, para evitar que el rango de la hoja destino quede seleccionado que debo hacer.

Puede ser algo como esto:

Sub pegadato()
    Application.ScreenUpdating = False
    u = Range("E" & Rows.Count).End(xlUp).Row
    Sheets("Liquidacion_Nomina").Range("E10:G" & u & ",M10:Q" & u & ",V10:Z" & u & ",AB10:AB" & u).Copy
    Sheets("Datos").Range("F6").PasteSpecial xlValues
    Sheets("Datos").Select
    Range("F6").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas