Macro pegar valores buscando el último dato

Es un gusto saludarlos.
Por favor si es posible, su ayuda con lo siguiente:
Tengo 2 hojas, Hoja1 y Hoja2. Necesito que los valores de la Hoja1 contenidos desde una tabla dinámica (desde A10:F10 hasta ultimo valor hacia abajo) se peguen como valores en la Hoja2 desde el último dato contenido en la columna B. Luego copiar la columna G de la Hoja1 (desde G10 hasta el ultimo valor hacia abajo) y pegarlo en la columna J pero de manera equivalente la posición de los valores anteriormente pegados.
Agrego unas fotos que demuestran mayor claridad en lo que necesito.

Muchas gracias!

Hoja1

Hoja2

Respuesta
1

Esto puede aportar algo más

https://youtu.be/DV7taRXLEzY

https://youtu.be/_XegDeHiORc

https://youtu.be/Z9Rv4Y-cF24

https://youtu.be/nPSFAZ8TvrQ

Visita https://programarexcel.com  descarga cientos de ejemplos de macros gratisSuscribe https://www.youtube.com/c/programarexcel?sub_confirmation=1  activa la campana y youtube te avisará cuando se suban nuevos vídeos

1 respuesta más de otro experto

Respuesta
2

Te anexo la macro

Sub Copiar_TD()
'Por Dante Amor
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    u2 = h2.Range("B" & Rows.Count).End(xlUp).Row + 1
    h1.Range("A10:F" & u1).Copy
    h2.Range("B" & u2).PasteSpecial xlValues
    h1.Range("G10:G" & u1).Copy
    h2.Range("J" & u2).PasteSpecial xlValues
    MsgBox "Fin"
End Sub

'.[Sal u dos. Dante Amor. No olvides valorar la respuesta.

'.[Avísame cualquier duda

Dante muchas gracias, funciona perfecto.
El único problema es que al ejecutar por segunda vez (digamos por accidente) vuelve a realizar el proceso y los datos se duplican o triplican según sea el caso.
Existe la posibilidad de una vez ejecutado el proceso este no se repita?

Quedaría así:

Sub Copiar_TD()
'Por Dante Amor
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    h2.cells.clearcontents
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    u2 = h2.Range("B" & Rows.Count).End(xlUp).Row + 1
    h1.Range("A10:F" & u1).Copy
    h2.Range("B" & u2).PasteSpecial xlValues
    h1.Range("G10:G" & u1).Copy
    h2.Range("J" & u2).PasteSpecial xlValues
    MsgBox "Fin"
End Sub

'.[Sal u dos. Dante Amor. No olvides valorar la respuesta.
'.[Avísame cualquier duda

Lamentablemente no funciona. Al agregar h2.Cells.ClearContents, elimina los valores de la Hoja2 sin buscar el último dato.
Con h2.Cells.ClearContents se pegan los valores en Hoja2 desde B2.

¿Y entonces cómo quieres?

Si te equivocas y presionas 2 veces, la macro pega los datos en la B2.

¿Cómo se puede saber si ya lo ejecutaste una vez y que la segunda vez es un error de ejecución?

La macro inicial cumple con lo que solicitaste. Si te equivocas en la ejecución, eso no lo mencionaste en tu petición original.

Si cumple de manera perfecta con lo solicitado.

Solo que esta macro la pasaré a varias personas y quería evitar que cometieran el error de ejecutarla varias veces y se duplicara el proceso.

Funciona perfecto, muchas gracias!

Pues podrías poner un mensaje de advertencia:

"Seguro que te quieres equivocar?" Sí, ¿No?

Si presionan Sí, pues entonces se van a equivocar, por más validaciones que pongas, si quieren equivocarse lo van a hacer.

Sub Copiar_TD()
'Por Dante Amor
    res = MsgBox("Quieres continuar", vbQuestion + vbYesNo, "COPIAR TABLA DINÁMICA")
    If res = vbNo Then Exit Sub
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    u1 = h1.Range("A" & Rows.Count).End(xlUp).Row
    u2 = h2.Range("B" & Rows.Count).End(xlUp).Row + 1
    h1.Range("A10:F" & u1).Copy
    h2.Range("B" & u2).PasteSpecial xlValues
    h1.Range("G10:G" & u1).Copy
    h2.Range("J" & u2).PasteSpecial xlValues
    MsgBox "Fin"
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas