Add row at specific location using vba

Hi All,

I have a spreadsheet (testing - attached) that has several sections with buttons that add and remove rows for that section. In my attached spreadsheet, the add button is only functional for Objectives. My code adds a new row after whatever cell is selected. I need it to go to a cell I've named "OBJ", select the row above it, copy and paste so the cell "OBJ" gets moved down to the next row (to be used if another row is added). The code I have so far is below, it copies the selected row and adds a new row below it, not quite what I am looking for:

 Sub AddRowDeleteConstants()
 On Error GoTo NoConstants
   With ActiveCell.EntireRow
      .Copy
      .Insert Shift:=xlDown
      .SpecialCells(xlCellTypeConstants).ClearContents
    End With
  Exit Sub
NoConstants:
 MsgBox "There were no constants to delete"
End Sub

Any help would be greatly appreciated.

Thanks.

Hello hrbreton,

Welcome to the Forum!

Both "add" buttons have the new macro attached to them. This uses the position of the button along with the bordering empty rows to determine the last row. There must be at least 3 rows present before the row will be copied. The two headers rows are excluded. The attached workbook has the macro added.

Sub AddNewRow()

  Dim LastRow As Long
  Dim Rng As Range
  Dim Shp As Shape
  
    Set Shp = ActiveSheet.Shapes(Application.Caller)
    Set Rng = Shp.TopLeftCell.CurrentRegion
    
    If Rng.Rows.Count > 2 Then
       LastRow = Rng.Rows.Count
       Rng.Rows(LastRow).Copy
    
       Rng.Rows(LastRow + 1).Insert Shift:=xlShiftDown
       Rng.Rows(LastRow + 1).PasteSpecial Paste:=xlPasteAll
       Rng.Rows(LastRow + 1).ClearContents
       
       Rng.Rows(LastRow + 1).Cells(1, 1) = Rng.Rows(LastRow).Cells(1, 1) + 1
       Rng.Rows(LastRow + 1).Cells(1, 2).Select
    End If
    
End Sub

Thanks for your reply. I have written some vba which does the trick. I hope it helps someone else:

Application.EnableEvents = False

Application.ScreenUpdating = False
With ActiveSheet
.Protect Password:="PASSWORD", _
UserInterFaceOnly:=True
Application.GoTo reference:="OBJ"
ActiveCell.Offset(-1, 0).Range("A1:AM1").Select
    Selection.Copy
Application.GoTo reference:="OBJ"
    Selection.Insert Shift:=xlDown

    Application.GoTo reference:="OBJ"
    ActiveCell.Offset(-1, 0).Range("A1:AM1").Select
        Selection.ClearContents
 End With