Solved: Repeat cells N Times

[justdream]

Dears,

Could you please support creating Macro that repeat each cell N times "above each other"

Sample:

[Artik]

[VBA]Sub AAA()
Dim LastRow As Long
Dim i As Long
Dim N As Integer
Dim CalcMode As XlCalculation

With Application
.ScreenUpdating = False
.EnableEvents = False
CalcMode = .Calculation
.Calculation = xlCalculationManual
End With

LastRow = Cells(Rows.Count, "A").End(xlUp).Row

For i = LastRow To 1 Step -1
N = 0
If IsNumeric(Cells(i, "B")) Then
N = Cells(i, "B").Value
If N > 0 Then
Rows(i & ":" & i + N - 2).Insert Shift:=xlDown
Cells(i + N - 1, "A").Resize(, 2).Copy
Cells(i, "A").Resize(N).PasteSpecial
End If
End If
Next i

Application.CutCopyMode = False
Cells(i + 1, "A").Select

With Application
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub[/VBA]

Artik

[snb]

Do you need help or a solution ?