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
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.
