Macro para insertar filas en blanco de acuerdo al valor de una celda

Espero se encuentren muy bien, necesito insertar filas en blanco a partir del valor de una celda, por ejemplo:

                    A                         

1                 1

2                 2

3                 2

al correr la macro debería quedar:

                     A

1                   1

2

3                   2

4       

5

6                    2

7

8

Actualmente estoy utilizando esta macro:

Sub Macro1()
Dim Filas, Fila, Columna As Integer
Filas = ActiveCell.Value2
Fila = ActiveCell.Row
Columna = ActiveCell.Column
Rows(Fila + 1 & ":" & Fila + Filas).Insert shift:=xlDown
Range(Cells(Fila, 1), Cells(Fila, Columna - 1)).Copy _
Destination:=Range(Cells(Fila + 1, 1), Cells(Fila + Filas, Columna - 1))
Cells(Fila + Filas + 1, 1).Select
End Sub

Pero solo funciona para la primera celda.

1 Respuesta

Respuesta
1

Usa esta macro

Sub insertar_filas()
Dim unicos As New Collection
Set datos = Range("a1").CurrentRegion
With datos
    For i = 1 To .Rows.Count
        numero = .Cells(i, 1)
        On Error Resume Next
        unicos.Add numero, CStr(numero)
        On Error GoTo 0
    Next i
    For j = 1 To unicos.Count
        numero = unicos.Item(j)
        cuenta = WorksheetFunction.CountIf(datos, numero)
        For i = 1 To cuenta
        If i = 1 Then Set busca = .Find(numero)
        If i > 1 Then Set busca = .FindNext(busca)
        Range(busca.Address).Offset(1, 0).Resize(numero).EntireRow.Insert
        Next i
    Next j
End With
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas