Macro Copiar y Pegar en bucle

Tengo un archivo con 2 hojas.
En la primera hoja tengo ciertos datos, que ya tengo la macro para que me genere la información en 3 rangos. (Así creo yo que se haría más fácil). Ese rango de datos las quiero copiar de la hoja 1, y pasarlo a la hoja 2, pero mas o menos así:

Primer rango AE:BS (primera fila de datos), pegar en la hoja 2, en A4

Segundo rango BU:DI (primera fila de datos), pegar en la hoja 2 en A5

Tercer rango DK:EY (primera fila de datos), pegar en la hoja 2, en A6

Primer rango, y copie la segunda fila de datos, y pegue en la hoja 2, en A7
Segundo rango (segunda fila de datos), pegar en hoja 2, en A8
Y así sucesivamente, hasta la última fila de datos.
Los datos serán variables, por ejemplo, en el archivo actual tengo unas 260 líneas (divididas en 3 rangos). Pero una veces serán más y otras menos

1 respuesta

Respuesta
1

Espero que te sirva:

Sub Copiar_Pegar_Rangos()
hoja_origen = "Hoja2"
hoja_destino = "Hoja3"
fila_origen = 1
fila_destino = 1

Application.ScreenUpdating = False
Do While Cells(fila_origen, 1) <> ""
'Copia y Pega Rango1
Worksheets(hoja_origen).Activate
Range(Cells(fila_origen, 1), Cells(fila_origen, 3)).Copy
Worksheets(hoja_destino).Activate
Cells(fila_destino, 1).PasteSpecial Paste:=xlPasteValues
'Copia y Pega Rango2
Worksheets(hoja_origen).Activate
Range(Cells(fila_origen, 4), Cells(fila_origen, 6)).Copy
Worksheets(hoja_destino).Activate
Cells(fila_destino + 1, 1).PasteSpecial Paste:=xlPasteValues
'Copia y Pega Rango3
Worksheets(hoja_origen).Activate
Range(Cells(fila_origen, 7), Cells(fila_origen, 9)).Copy
Worksheets(hoja_destino).Activate
Cells(fila_destino + 2, 1).PasteSpecial Paste:=xlPasteValues
fila_origen = fila_origen + 1
fila_destino = fila_destino + 3
Loop
Application.ScreenUpdating = True
End Sub

¡Gracias! 

Logré dar con un código que al parecer funciona, pero el tuyo es mucho más fácil.
Aún así, la voy a adaptar a mi hoja para probar.

Saludos.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas