Force a user to select the entire row from row number

[Bagsy]

Can somebody help a bit please, I have cobbled together the below code to allow the user to insert extra rows. But I have a couple of problems.

1. I need be able to force the user to select the entire row, because at the moment if they select a cell not the row, the code just inserts a copy the active cell. I did try “ActiveCell.EntireRow.Copy” but this errored out on the next line “Selection.Insert Shift:=xlDown”.

2. The other part I would like to achieve is I would like to put something in column O like (do not insert rows here) so the code would check for this value and prevent any rows being entered, with a msgbox stating that you cannot insert rows here. This will enable me to protect parts of the sheet from the user inserting rows.

Any help is much appreciated

Sub AddRows()

    Dim n As Integer
    Dim Ans As Variant
'    On Error Resume Next

ActiveSheet.Unprotect
 Ans = MsgBox("Have you selected the entire row where you want to add the extra rows", vbYesNo)
 If Ans = vbYes Then

    n = InputBox("How many rows do you require?")
        If n >= 1 Then
            For numtimes = 1 To n
              Selection.Copy
    Selection.Insert Shift:=xlDown

Next
End If
ActiveSheet.Protect

Else
ActiveSheet.Protect
   Exit Sub
   End If
End Sub

 

[Bagsy]

Footoo
Tried your suggestion works brilliantly, much neater
Thank you

Sub AddRows()
Dim n As Variant, Ans As Variant
 
If TypeName(Selection) <> "Range" Then
    MsgBox "Select a worksheet cell."
    Exit Sub
ElseIf Selection.Rows.Count > 1 Then
    MsgBox "Select in one row only."
    Exit Sub
ElseIf Selection.Row < 14 Then
    MsgBox "The selection must not be in the header rows"
    Exit Sub
ElseIf Not Intersect(Selection, Range("Last_Rows")) Is Nothing Then ' this is the named range/area (Last_Rows) on the sheet
    MsgBox "The selection must not be in the formula rows at the bottom of the sheet,"
    Exit Sub
End If
 
Ans = MsgBox("Is your selection in the row where you want to add the extra rows", vbYesNo)
If Ans = vbNo Then Exit Sub
Application.DisplayAlerts = False
n = Application.InputBox(Prompt:="How many rows do you require?", Type:=1)
Application.DisplayAlerts = True
If TypeName(n) = "Boolean" Or n = 0 Then Exit Sub
n = Val(n)
If n > 49 Then
    MsgBox "Enter a number less than 50"
    Exit Sub
End If
ActiveSheet.Unprotect
Selection.EntireRow.Copy
Selection.Resize(n).EntireRow.Insert
ActiveSheet.Protect
End Sub

 

[Bagsy]

Could somebody help please?
I would like to change this part of the below code

Selection.EntireRow.Copy
Selection.Resize(n).EntireRow.Insert

So it just copies and inserts the row with formats only (does not copy any text) so in effect when the user insert rows they will be blank but formatted.
I have tried

Selection.EntireRow.Copy = xlFormatsOnly

but that does not work at all
I have seen some examples but they are using the paste method
Any help is very much appreciated

Sub AddRows()
Dim n As Variant, Ans As Variant
 
If TypeName(Selection) <> "Range" Then
    MsgBox "Select a worksheet cell."
    Exit Sub
ElseIf Selection.Rows.Count > 1 Then
    MsgBox "Select in one row only."
    Exit Sub
ElseIf Selection.Row < 14 Then
    MsgBox "The selection must not be in the header rows"
    Exit Sub
ElseIf Not Intersect(Selection, Range("Last_Rows")) Is Nothing Then ' this is the named range/area (Last_Rows) on the sheet
    MsgBox "The selection must not be in the formula rows at the bottom of the sheet,"
    Exit Sub
End If
 
Ans = MsgBox("Is your selection in the row where you want to add the extra rows", vbYesNo)
If Ans = vbNo Then Exit Sub
Application.DisplayAlerts = False
n = Application.InputBox(Prompt:="How many rows do you require?", Type:=1)
Application.DisplayAlerts = True
If TypeName(n) = "Boolean" Or n = 0 Then Exit Sub
n = Val(n)
If n > 49 Then
    MsgBox "Enter a number less than 50"
    Exit Sub
End If
ActiveSheet.Unprotect
Selection.EntireRow.Copy
Selection.Resize(n).EntireRow.Insert
ActiveSheet.Protect
End Sub

 

[footoo]

Selection.EntireRow.Copy
With Selection.Resize(n).EntireRow
    .Insert
    .Offset(-n).ClearContents
End With

 

[Bagsy]

Not working exactly it seems to be inserting an extra row (which isn’t formatted the cells are unmerged on the extra row)
The other row inserted is OK

Sub AddRows()
Dim n As Variant, Ans As Variant
 
If TypeName(Selection) <> "Range" Then
    MsgBox "Select a worksheet cell."
    Exit Sub
ElseIf Selection.Rows.Count > 1 Then
    MsgBox "Select in one row only."
    Exit Sub
ElseIf Selection.Row < 14 Then
    MsgBox "The selection must not be in the header rows"
    Exit Sub
ElseIf Not Intersect(Selection, Range("Last_Rows")) Is Nothing Then ' this is the named range/area (Last_Rows) on the sheet
    MsgBox "The selection must not be in the formula rows at the bottom of the sheet,"
    Exit Sub
End If

Ans = MsgBox("Is your selection in the row where you want to add the extra rows", vbYesNo)
If Ans = vbNo Then Exit Sub
Application.DisplayAlerts = False
n = Application.InputBox(Prompt:="How many rows do you require?", Type:=1)
Application.DisplayAlerts = True
If TypeName = "Boolean" Or n = 0 Then Exit Sub
n = Val
If n > 49 Then
MsgBox "Enter a number less than 50"
Exit Sub
End If
ActiveSheet.Unprotect
Selection.EntireRow.Copy
With Selection.Resize.EntireRow
.Insert
.Offset(-n).ClearContents
End With
Selection.Resize.EntireRow.Insert
ActiveSheet.Protect
End Sub

 

[footoo]

You should have replaced this line : Selection.Resize.EntireRow.Insert

Delete it.

 

[Bagsy]

Can’t thank you enough Footoo