Como crear una macro que copie de una fila a otra fila unas columnas y me las copie en dos hojas distintas en unas filas/colum
Como crear una macro
Macro que relice:
1º La macro pregunta al usuario entre que fila ha que fila quiero copiar datos de la "Hoja 1".( Por ejemplo entre la fila 8 y la fila 25 .
2º Una vez sabido entre que filas hay que copiar datos, (fila-hoja1-x a la fila-hoja1-y definiidas por el usuario), copia los valores de la columnas A, B, C, DE, E, F, G, H, I, J, N, P, T, Y comprendidos entre las dos filas.
3º Luego la macro pregunta al usuario, entre que filas de la "Hoja2"(fila-hoja2-x2 a fila-hoja2-y2)) hay que pegar los datos copiados. Los datos copiados de las columnas de la "Hoja1" a pegarlos en la "Hoja 2" entre las filas definidas en la Hoja 2". Además sabido, entre que líneas se tienen que pegar el valor de la columnas copiadas de la "Hoja1", se tiene que pegar en la "hoja 3" entre las mismas líneas seleccionadas en la hoja 2", los valores de las columnas.
La corespondencia de copia en "Hoja 1" y pegado en "Hoja 2" y la corespondencia de copia de "Hoja1" y pegado "Hoja 3" se definen debajo:
"Hoja 1" " Hoja 2" "Hoja 3"
A---------------------------------------------------------A
B---------------------------------------------------------B
C---------------------------------------------------------C
D---------------------A
E---------------------B
F---------------------C
G--------------------D
H--------------------E
I--------------------- F
J-------------------G
N-----------------------------------------------------U
P-----------------------------------------------------W
T-----------------------------------------------------AA
Y-----------------------------------------------------AC
[Ho la y bienvenido a TodoExpertos!
Prueba la siguiente macro.
Primero selecciona las filas a copiar, por ejemplo puedes seleccionar de la celda A8 a A25.
Después selecciona la celda destino. No es necesario que selecciones las filas destino, basta con seleccionar la primera celda destino.
Sub Copiar_Datos()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Dim rng1 As Range, rng2 As Range, r As Range
Dim fila As Long
'
Set sh1 = Sheets("Hoja1")
Set sh2 = Sheets("Hoja2")
Set sh3 = Sheets("Hoja3")
'
On Error Resume Next
sh1.Select
Range("A1").Select
Set rng1 = Application.InputBox("Selecciona las filas a copiar", _
sh1.Name, Default:=Selection.Address, Type:=8)
If rng1 Is Nothing Then Exit Sub
'
sh2.Select
Range("A1").Select
Set rng2 = Application.InputBox("Selecciona la celda destino", _
sh2.Name, Default:=Selection.Address, Type:=8)
If rng2 Is Nothing Then Exit Sub
On Error GoTo 0
fila = rng2.Cells(1, 1).Row
For Each r In rng1.Rows
sh3.Range("A" & fila).Value = sh1.Range("A" & r.Row).Value
sh3.Range("B" & fila).Value = sh1.Range("B" & r.Row).Value
sh3.Range("C" & fila).Value = sh1.Range("C" & r.Row).Value
sh2.Range("A" & fila).Value = sh1.Range("D" & r.Row).Value
sh2.Range("B" & fila).Value = sh1.Range("E" & r.Row).Value
sh2.Range("C" & fila).Value = sh1.Range("F" & r.Row).Value
sh2.Range("D" & fila).Value = sh1.Range("G" & r.Row).Value
sh2.Range("E" & fila).Value = sh1.Range("H" & r.Row).Value
sh2.Range("F" & fila).Value = sh1.Range("I" & r.Row).Value
sh2.Range("G" & fila).Value = sh1.Range("J" & r.Row).Value
sh3.Range("U" & fila).Value = sh1.Range("N" & r.Row).Value
sh3.Range("W" & fila).Value = sh1.Range("P" & r.Row).Value
sh3.Range("AA" & fila).Value = sh1.Range("T" & r.Row).Value
sh3.Range("AC" & fila).Value = sh1.Range("Y" & r.Row).Value
fila = fila + 1
Next
End Sub[No olvides valorar la respuesta.
