Inserting A Row Macro

[Guest]

Hi,

I'm developing a spreadsheet which requires a Macro to insert a line into a
list of items. Currently I have a Macro that inserts/deletes a row to the top
of the list. However, it has been requested that the user be able to pick any
point in the list and insert a row. I tried turning off the security
restrictions for contents - the user can insert a row (using the right click
shortcut) but the formulas are not copied into the new row.

Does anyone know of a way I can allow the user to select the row and
activate the Macro to insert the line at this point...?

My current code is below ( i realise i may well have gone the long way round
inserting a line - i'm only a beginner!).
------------------------------------------------------------------
Application.ScreenUpdating = False
ActiveSheet.Unprotect "gpro"
Rows("13:13").Select
Selection.Copy
Rows("13:13").Select
Selection.Insert Shift:=xlDown
Range("G13:Q13").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("K13").Select
ActiveWindow.SmallScroll ToRight:=5
Range("L14").Select
Selection.AutoFill Destination:=Range("L13:L14"), Type:=xlFillDefault
Range("L13:L14").Select
Range("L13").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-4]="""","""",IF(R[-7]C[-2]="""","""",R[-7]C[-2]))"
Range("O14").Select
Selection.AutoFill Destination:=Range("O13:O14"), Type:=xlFillDefault
Range("O13:O14").Select
Range("P14").Select
Selection.AutoFill Destination:=Range("P1314"), Type:=xlFillDefault
Range("P1314").Select
ActiveWindow.SmallScroll ToRight:=1
ActiveWindow.ScrollColumn = 1
Range("E13").ClearContents
Range("G13").Select
ActiveCell.Value = "PM"
Range("F13").Formula = "=H10"
Range("L13").Formula = "=J6"
Range("C13").Select
ActiveSheet.Protect "gpro", DrawingObjects:=True, Contents:=False,
Scenarios:=True
Application.ScreenUpdating = False

 

[R.VENKATARAMAN]

ActiveCell.EntireRow.Insert


==============================

 

[Harald Staff]

Hi Phil

See if you can use some of this:

Sub NewRow()
Dim R As Long
Dim Cel As Range
On Error Resume Next
Set Cel = Application.InputBox("New row below this cell:", _
"New row", ActiveCell.Address, Type:=8)
If Cel Is Nothing Then Exit Sub
R = Cel(1).Row + 1
Rows(R).Insert
Range(Cells(R - 1, 1), Cells(R - 1, 256)).Copy _
Range(Cells(R, 1), Cells(R, 256))
End Sub

HTH. Best wishes Harald