Insert multiple rows with fill number in a specific row

[Unexpc]

Hi guys
i have several customer in a sheet that have separator (a gray row) between every customer, now, when i write a number in this rows, insert rows up with that amount

 

[Unexpc]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, j As Long, Lr1 As Long, Lr2 As Long, Cr As Long, CrR As String
Dim Lr3 As Long, Lr4 As Long, K As Long
Lr1 = Sheets("Dashboard").Range("I" & Rows.Count).End(xlUp).Row
Lr2 = Sheets("Dashboard").Range("N" & Rows.Count).End(xlUp).Row
Lr3 = Sheets("Work").Range("A" & Rows.Count).End(xlUp).Row
Lr4 = Sheets("Paper").Range("A" & Rows.Count).End(xlUp).Row

  If Intersect(Target, Union(Range("A1:A" & Lr3), Range("E3:E1048576,G3:G1048576"))) Is Nothing Then Exit Sub
   If Not Intersect(Target, Range("E3:E1048576,G3:G1048576")) Is Nothing Then
   If Target.Count = 1 Then
   If Target.Value > 0 Then Target = Target.Value * -1
   End If
   End If
   On Error Resume Next
  If Intersect(Target, Range("A1:A" & Lr3)) Is Nothing Then Exit Sub
  Application.EnableEvents = False
  If Target.Interior.Color = 14277081 Then
  If Target.Value <> "" Then
  Range("A" & Target.Row & ":G" & Target.Row + Target.Value - 1).Insert Shift:=xlDown
  Target.Value = ""
  End If
  End If
  For i = 3 To Lr1 - 1
   Cr = Application.WorksheetFunction.Match(Sheets("Dashboard").Range("I" & i).Value, Sheets("Work").Range("A1:A" & Lr3), 0)
   CrR = Range("A" & Cr).Address
     Sheets("Dashboard").Range("I" & i).Hyperlinks.Delete
     Sheets("Dashboard").Hyperlinks.Add Anchor:=Sheets("Dashboard").Range("I" & i), Address:="", SubAddress:="'" & Sheets("Work").Name & "'!" & CrR, TextToDisplay:=Sheets("Dashboard").Range("I" & i).Value
     With Sheets("Dashboard").Range("I" & i)
                .Font.Underline = xlUnderlineStyleNone
                .Font.ColorIndex = xlColorIndexAutomatic
                .Font.Name = "Arial"
                .Font.Size = 14
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
     End With
  Next i
  Application.EnableEvents = True
End Sub

This is correct, THANK YOU