Sub AddRowsByFieldValue(StartRow As Integer, ColumnNumber As Integer)
i = StartRow
Do
If Cells(i, ColumnNumber).Value <> 0 Then
NumberOfRowToInsert = Cells(i, ColumnNumber).Value
For j = 1 To NumberOfRowToInsert
Rows(i + j).Select
Selection.Insert Shift:=xlDown
Next
i = i + j
Else
Exit Do
End If
Loop
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Call AddRowsByFieldValue(ActiveCell.Row, ActiveCell.Column)

End Sub 

Option Explicit
Const sMenuBarName As String = "Test"
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next 
    Application.CommandBars(sMenuBarName).Delete
End Sub
Private Sub Workbook_Open()
    On Error Resume Next 
    Application.CommandBars(sMenuBarName).Delete
    On Error GoTo 0
       With Application.CommandBars.Add(sMenuBarName, temporary:=True)
                With .Controls.Add
                        .Caption = "Вставка пустых строк по значению ячейки"
                        .Style = 3
                        .FaceId = 2
                        .OnAction = "AddRowsByFieldValue"
        End With
                .Visible = True
    End With
End Sub

Sub Fill_Gaps()   
Selection.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
End Sub