Macro para copiar contenido de celdas si celda activa esta vacía
Buen día;
Nuevamente abusando de sus conocimientos;
Me gustaría hacer una macro que copie el contenido de las celdas superiores en la celda activa (vacía) no se si me explique bien pero es algo asi:
>
Debiendo quedar asi:
>
1 Respuesta
Espero estés bien.
Te paso un código que considero puede solucionar tu problema. Tenes que definir un final. Yo lo hice en la celda C20.
Sub Macro1()
'
' Macro1 Macro
'
'
Dim ULTIMA As Integer
ULTIMA = Range("C20").End(xlUp).Row
For i = 1 To ULTIMA
Range("C1").Select
Selection.End(xlDown).Select
ActiveCell.Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, -1).Select
ActiveCell.Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 2).Select
ActiveCell.Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next i
End Sub
No me funciona,
Es un poco mas complicado de lo que se ve mira quiero que la macro localice de la columna "D" las celdas con el contenido 0 y vacías y que en estas ponga la formula que muestre el contenido de la celda superior inmediata:
Ejemplo:
juan 01/02/2014 100
0
jorge 01/03/2014 200
sofia 01/01/2014 200
0
debiendo quedar asi:
juan 01/02/2014 100
juan 01/02/2014 100
jorge 01/03/2014 200
sofia 01/01/2014 200
sofia 01/01/2014 200
Espero estés de maravilla.
Desde ya te pido disculpas por la demora. El siguiente código puede resolver tu problema.
Sub Macro2()
Range("d1").Select
Do While ActiveCell.Value <> ""
ValorBuscado = ActiveCell.Value
If InStr(ValorBuscado, "0") Then
ActiveCell.Offset(-1, -3).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 1).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 1).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 1).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
