Quiero copiar valores de la columna b en la columna a
Tengo lo siguiente
a
b
c
Y quiero que ocurra lo siguiente
A a
a
a
b b
b
c c
c
c
c
c
a
b
c
Y quiero que ocurra lo siguiente
A a
a
a
b b
b
c c
c
c
c
c
1 respuesta
Respuesta de boumerang
1
Si, hay una fila libre entre cada conjunto
OK. Entiendo que Es como un Rellenar hacia abajo pero, dejando una fila libre. Confirma o corrige.
Correcto
Interesante aplicación. Aquí está el código.
-
Sub RellenarHaciaArriba()
Dim CELDA As Range
Dim INICIO As Integer
Dim FIN As Integer
Dim RANGO As String
For Each CELDA In Range("B:B")
If INICIO = 0 Then
If Not CELDA.Value = "" Then
INICIO = CELDA.Row
CELDA.Copy
Else
If CELDA.Value = "FIN" Then Exit For
End If
Else
If Not CELDA.Value = "" Then
FIN = CELDA.Row - 2
RANGO = "A" & INICIO & ":" & "A" & FIN
Range(RANGO).Select
ActiveSheet.Paste
If CELDA.Value = "FIN" Then Exit For
INICIO = CELDA.Row
CELDA.Copy
End If
End If
Next CELDA
Range("A1").Activate
Application.CutCopyMode = False
End Sub
-
-
Sub RellenarHaciaArriba()
Dim CELDA As Range
Dim INICIO As Integer
Dim FIN As Integer
Dim RANGO As String
For Each CELDA In Range("B:B")
If INICIO = 0 Then
If Not CELDA.Value = "" Then
INICIO = CELDA.Row
CELDA.Copy
Else
If CELDA.Value = "FIN" Then Exit For
End If
Else
If Not CELDA.Value = "" Then
FIN = CELDA.Row - 2
RANGO = "A" & INICIO & ":" & "A" & FIN
Range(RANGO).Select
ActiveSheet.Paste
If CELDA.Value = "FIN" Then Exit For
INICIO = CELDA.Row
CELDA.Copy
End If
End If
Next CELDA
Range("A1").Activate
Application.CutCopyMode = False
End Sub
-
