Macro que inserte filas
Necesitaría una Macro que me inserte filas, a lo largo de una columna, (unas 50 celdas), tantas como el valor de la celda, siempre que dicho valor sea mayor que 1, es decir, si A1 =3, me inserte 2 filas, copiando el valor de A1, y en el rango B2:B3 creado, copie el valor de B1 y así sucesivamente, de manera que en la columna B, repita el valor tantas veces como indica la columna A.
Una cosa +o- asi:
A1=3 B1=2020
A2=2 B2=3030
Resultado:
A1=3 B1=2020
A2=3 B2=2020
A3=3 B3=2020
A4=2 B4=3030
A5=2 B5=3030
Y así sucesivamente.
Muchísimas Gracias.
Una cosa +o- asi:
A1=3 B1=2020
A2=2 B2=3030
Resultado:
A1=3 B1=2020
A2=3 B2=2020
A3=3 B3=2020
A4=2 B4=3030
A5=2 B5=3030
Y así sucesivamente.
Muchísimas Gracias.
1 respuesta
Respuesta de caranbis
1
Servido Sr. José María.
Selecciona la ÚLTIMA celda llena de la COLUMNA A, y luego ejecuta la macro
Sub Macro1()
Dim inicio As Double
Dim fin As Double
Dim rangoinsert As String
Dim celdant As Range
Application.ScreenUpdating = False
While ActiveCell.Row > 0
If IsNumeric(ActiveCell) And ActiveCell > 1 Then
inicio = ActiveCell.Row + 1
fin = ActiveCell.Row + ActiveCell - 1
rangoinsert = inicio & ":" & fin
Rows(rangoinsert).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
For i = inicio To fin
Cells(i, 1) = Cells(inicio - 1, 1)
Cells(i, 2) = Cells(inicio - 1, 2)
Next
End If
If ActiveCell.Row <> 1 Then
ActiveCell.Offset(-1, 0).Select
Else
Exit Sub
End If
Wend
End Sub
Carlos L.
Selecciona la ÚLTIMA celda llena de la COLUMNA A, y luego ejecuta la macro
Sub Macro1()
Dim inicio As Double
Dim fin As Double
Dim rangoinsert As String
Dim celdant As Range
Application.ScreenUpdating = False
While ActiveCell.Row > 0
If IsNumeric(ActiveCell) And ActiveCell > 1 Then
inicio = ActiveCell.Row + 1
fin = ActiveCell.Row + ActiveCell - 1
rangoinsert = inicio & ":" & fin
Rows(rangoinsert).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
For i = inicio To fin
Cells(i, 1) = Cells(inicio - 1, 1)
Cells(i, 2) = Cells(inicio - 1, 2)
Next
End If
If ActiveCell.Row <> 1 Then
ActiveCell.Offset(-1, 0).Select
Else
Exit Sub
End If
Wend
End Sub
Carlos L.
