Macro copiar y pegar celda reiteradamente
Hola:
Necesito crear una macro que copie y pegue en otra hoja cada una de las celdas de un rango tantas veces hacia abajo como indique el número de la celda adyacente.
Ej:
hoja1 hoja2
Columna1 columna2 Columna1
auto 3 auto
casa 2 auto
Auto
Casa
Casa
Gracias de antemano por su ayuda.
Necesito crear una macro que copie y pegue en otra hoja cada una de las celdas de un rango tantas veces hacia abajo como indique el número de la celda adyacente.
Ej:
hoja1 hoja2
Columna1 columna2 Columna1
auto 3 auto
casa 2 auto
Auto
Casa
Casa
Gracias de antemano por su ayuda.
1 Respuesta
Respuesta de juanbauzam
1
Ahí va tu macro.
Sub copiar()
Dim obj As String
Dim num As Integer
Dim x As Integer
Sheets("Hoja1").Select
Range("A1").Select
Do While Not IsEmpty(ActiveCell)
obj = ActiveCell
num = ActiveCell.Offset(0, 1)
Sheets("Hoja2").Select
Range("A1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
For x = 1 To num
ActiveCell = obj
ActiveCell.Offset(1, 0).Select
Next
Sheets("Hoja1").Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub copiar()
Dim obj As String
Dim num As Integer
Dim x As Integer
Sheets("Hoja1").Select
Range("A1").Select
Do While Not IsEmpty(ActiveCell)
obj = ActiveCell
num = ActiveCell.Offset(0, 1)
Sheets("Hoja2").Select
Range("A1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
For x = 1 To num
ActiveCell = obj
ActiveCell.Offset(1, 0).Select
Next
Sheets("Hoja1").Select
ActiveCell.Offset(1, 0).Select
Loop
End Sub
