ایجاد ردیف‌های خالی بر اساس عدد موجود در سلول در اکسل

Sub Insert()
'pctarfand.ir & tarfandha.blog.ir'
 Dim xRg As Range
 Dim xAddress As String
 Dim I, xNum, xLastRow, xFstRow, xCol, xCount As Long
 On Error Resume Next
 xAddress = ActiveWindow.RangeSelection.Address
 Set xRg = Application.InputBox("Select a range to use(single column):", "KuTools For Excel", xAddress, , , , , 8)
 If xRg Is Nothing Then Exit Sub
 Application.ScreenUpdating = False
 xLastRow = xRg(1).End(xlDown).Row
 xFstRow = xRg.Row
 xCol = xRg.Column
 xCount = xRg.Count
 Set xRg = xRg(1)
 For I = xLastRow To xFstRow Step -1
  xNum = Cells(I, xCol)
  If IsNumeric(xNum) And xNum  0 Then
   Rows(I + 1).Resize(xNum).Insert
   xCount = xCount + xNum
  End If
 Next
 xRg.Resize(xCount, 1).Select
 Application.ScreenUpdating = True
End Sub

2)روی دکمه کلیک کنید یا کلید F5 را فشار دهید. با انجام اینکار پنجره زیر ظاهر می‌شود. سپس لیست اعداد مدنظرتان را انتخاب کنید تا بر اساس آن‌ها ردیف‌های خالی ایجاد شود.