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 Respuesta
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 Subsal 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
