Insert Button

[pik24]

I am trying to insert a button with macros to insert a row below a particular row each time this button is clicked. I took some help and put below code, not working out, can some one help

Sub InsertRowHere()
Selection.EntireRow.Insert
i = ActiveCell.Row
Rows(i - 5 & ":" & i - 5).EntireRow.Copy Cells(i, "A")
End Sub
ActiveWorkbook.Save
ActiveSheet.Shapes("Button 1").Select
Selection.OnAction = "InsertRowHere"
ActiveSheet.Shapes("Button 1").Select
Selection.Characters.Text = "INSERT"
With Selection.Characters(Start:=1, Length:=6).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("E11").Select
Application.Run "'TEST BOOK.xls'!InsertRowHere

 

[EducatedFool]

Try

Sub test()
    'CreateButton Selection, vbGreen, "Add new row", "InsertRowHere"
    CreateButton [d5:e6], vbRed, "Add new row", "InsertRowHere"
End Sub

Function CreateButton(ByRef ra As Range, ByVal Button_color As Long, ByVal txt As String, _
                      Optional ByVal MacroName As String = "")
    On Error Resume Next: Err.Clear
    w = ra.Width: h = ra.Height: w = IIf(w > 10, w, 50): h = IIf(h > 10, h, 50)
    l = ra.Left: t = ra.Top: If Button_color = 0 Then Button_color = 255
    If txt = "" Then txt = "Run"
    Dim sha As Shape: Set sha = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, l, t, w, h)
    With sha
        .Fill.Visible = msoTrue: .Fill.Solid: .Fill.ForeColor.RGB = Button_color: .Fill.Transparency = 0.3
        .Fill.BackColor.RGB = vbWhite: .Fill.TwoColorGradient msoGradientFromCenter, 2
        .Adjustments.Item(1) = 0.23: .Placement = xlFreeFloating: .OLEFormat.Object.PrintObject = False
        With .TextFrame
            .Characters.Text = txt
            With .Characters.Font
                .Size = IIf(h >= 16, 10, 8): .Bold = True: .Name = "Arial Narrow": .Name = "Arial"
            End With
            .HorizontalAlignment = xlCenter: .VerticalAlignment = xlVAlignCenter
        End With
        .OnAction = MacroName
    End With
End Function

Sub InsertRowHere()
    Selection.EntireRow.Insert
    ActiveCell.EntireRow.Offset(-5).Copy ActiveCell.EntireRow
End Sub

 

[pik24]

can any one confirm on this