Insert blank rows based on cell value

[Admin]

Hi

Try

Sub muhammad_susanto()
    'insert blank rows between base on count of each rows'
    Dim LR As Long
    Dim I As Long
    Dim Rng As Range
    
    Dim Ofst As Integer
    LR = Cells(Rows.Count, "C").End(xlUp).Row
    
    Set Rng = Range("c16:c" & LR)
    With Rng
        For I = .Rows.Count To 1 Step -1
            Ofst = .Cells(I, 1).Value
            If Ofst > 0 Then
                Ofst = IIf(Ofst = 1, 1, Ofst - 1)
                .Cells(I + 1, 1).Resize(Ofst).EntireRow.Insert
                .Cells(I, 2).Resize(Ofst + 1).Value = .Cells(I, 2).Value
            End If
        Next I
    End With
End Sub