How about:

Option Explicit

Sub Macro99()
Dim numRows As Long
Dim iRow As Long
Dim LastRow As Long
Dim FirstRow As Long

numRows = Application.InputBox("How many Rows", Type:=1)

If numRows < 1 Then Exit Sub

Application.ScreenUpdating = False
With ActiveSheet
FirstRow = 5 '<--
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(numRows).Insert
.Rows(iRow).Copy _
Destination:=.Rows(iRow + 1).Resize(numRows)
.Cells(iRow + 1, "D").Resize(numRows) = 110
'On Error Resume Next
'.Rows(iRow + ).Resize(numRows)
'.Cells.SpecialCells(xlCellTypeConstants).ClearCon tents
'On Error GoTo 0
Next iRow
End With
Application.ScreenUpdating = True
End Sub



sloanranger wrote:

Dave,

thankyou very much for you efforts- the macro works great, unfortunatly
i am not formiliar with any of this VB language, although i am trying.
I would like to tailer the code somemore so it does exactley what i
need.

i have removed the clear constants bit as i do need these!!

Idealy i would like to insert rows between row5 and the last and also
if possible add the value of 110 to a cell in in each of the row
generated (not the originals),the cell in question is in column D, this
would be fantastic if you get it to work.

Thanks very much for you speedy reply, i have included your code that i
have ammended.

Sub Macro99()
Dim numRows As Long
Dim iRow As Long
Dim LastRow As Long
Dim FirstRow As Long

numRows = Application.InputBox("How many Rows", Type:=1)

If numRows < 1 Then Exit Sub

Application.ScreenUpdating = False
With ActiveSheet
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(numRows).Insert
.Rows(iRow).Copy _
Destination:=.Rows(iRow + 1).Resize(numRows)
On Error Resume Next
'.Rows(iRow + ).Resize(numRows)
'
.Cells.SpecialCells(xlCellTypeConstants).ClearCont ents
On Error GoTo 0
Next iRow

End With
Application.ScreenUpdating = True
End Sub

Regards
Lee sloan

Dave Peterson wrote:
You're inserting x number of rows between row 1 and the last used
cell column A?

if yes, then you can copy those rows, then come back and wipe out the
constants
(leaving the formulas and formating).

Option Explicit
Sub Macro1A()
Dim numRows As Long
Dim iRow As Long
Dim LastRow As Long
Dim FirstRow As Long

numRows = Application.InputBox("How many Rows", Type:=1)

If numRows < 1 Then Exit Sub

Application.ScreenUpdating = False
With ActiveSheet
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
.Rows(iRow + 1).Resize(numRows).Insert
.Rows(iRow).Copy _
Destination:=.Rows(iRow + 1).Resize(numRows)
On Error Resume Next
.Rows(iRow + ).Resize(numRows) _

.Cells.SpecialCells(xlCellTypeConstants).ClearCont ents
On Error GoTo 0
Next iRow

End With
Application.ScreenUpdating = True
End Sub


sloanranger wrote:

i need a macro that inserts rows the same as the macro below but
will
also copy the formatting and formula from the row above

Sub Macro1()
'-- Ken Wright, 2003-08-09
Application.ScreenUpdating = False
Dim numRows As Integer
Dim r As Long
Dim Rng As Range
Dim lastrw As Long
numRows = InputBox("How many Rows")
lastrw = Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Range(Cells(1, "A"), Cells(lastrw, "A"))
For r = Rng.Rows.Count To 1 Step -1
Rng.Rows(r + 1).Resize(numRows).EntireRow.Insert
Next r
Application.ScreenUpdating = True
End Sub

--

Dave Peterson

--

Dave Peterson