Adding mutiple rows

Hi, I would like to have a button where the user can add a new product.
So when clicking the button, four new rows should be added with the right style.

See attached pictures

2013-08-26_085638.png

2013-08-26_085742.png

I did this...

Private Sub add_product_Click()
    ActiveSheet.Unprotect
    ActiveSheet.Range("A4").Select
    ActiveCell.EntireRow.Insert Shift:=xlDown
    ActiveCell.EntireRow.Insert Shift:=xlDown
    ActiveCell.EntireRow.Insert Shift:=xlDown
    ActiveCell.EntireRow.Insert Shift:=xlDown
    
    Range("B5:G5").Select
    Selection.Merge
      
    Range("A4:SM4").Select
    Selection.Locked = True
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = RGB(244, 176, 132)
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
   
    Range("A11").Select
    Application.CutCopyMode = False
    Selection.Copy
    
    Range("A7").Select
    ActiveSheet.Paste
    Range("A7").Select
    Selection.Locked = False
    Selection.HorizontalAlignment = xlCenter
    
    Range("B5:G5").Select
    ActiveCell.FormulaR1C1 = "Insert product name"
    Range("A10").Select
    Selection.Copy
    Range("A6").Select
    ActiveSheet.Paste
  
    Application.CutCopyMode = False
    Range("H9:SM11").Select
    Selection.Copy
    Range("H5:SM7").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.ClearContents
    
    Range("B6:G7").Select
    Selection.NumberFormat = "0.00"
    With Range("B6:G7").Validation
        .Add Type:=xlValidateDecimal, _
        AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:="0", Formula2:="99999"
        .InputTitle = "Integers"
        .ErrorTitle = "Integers"
        .InputMessage = "Enter an decimal or integer"
        .ErrorMessage = "You must enter a decimal or integer"
    End With
            
    ActiveSheet.Range("A5").Select
    With ActiveSheet.Buttons.Add(Selection.Left, Selection.Top, Selection.Width, Selection.Height)
        .OnAction = "delete_click"
        .Characters.Text = "Delete Product"
    End With
    
    Range("B5").Select
    Selection.Locked = False
    
    Range("B6:G7").Select
    Selection.Locked = False
    
    Range("H5:SM5").Select
    Selection.Locked = False
     
    ' This must be open when $ is chosen
    Range("H6:SM6").Select
    Selection.Locked = False
    
    Range("H7:SM7").Select
    Selection.Locked = True
    
    
    Application.ScreenUpdating = True
    ActiveWorkbook.Save
    ActiveSheet.Protect
End Sub