create blank rows

[Guest]

I have the following code which basically adds 25 blank rows at the end of
the sheet:

Sub Add25BlankRows()
Dim InsertionPoint As Range, rg As Range
Dim colToCheck As String
Dim expandBy As Long
Dim wsh As Worksheet
'Select Sheet and Sort by Work Order #
Sheets("Maintenance Log").Select
Range("B2:M65000").Sort Key1:=Range("B3"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'---- CHANGE HERE -------
Set wsh = ActiveSheet
colToCheck = "B"
expandBy = 25
'Find last currently used row in column colToCheck
Set InsertionPoint = wsh.Range(colToCheck & 65536).End(xlUp) _
.Offset(1, 0).EntireRow
'Insert rows
Set rg = InsertionPoint.Resize(expandBy)
rg.Insert
'Insert Work Order Numbers
Set rg = Range(InsertionPoint.Offset(-expandBy),
InsertionPoint.Offset(-1))
Set rg = Application.Intersect(rg, rg.Parent.Range(colToCheck & ":" & _
colToCheck))
rg.Formula = "=" & rg.Cells(1).Offset(-1, 0).Address(False, False) & "+1"
rg.Copy
rg.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub

I now have a formula in Columns C and D and would like the macro to copy
these formulas down into the added rows. Any help out there?

 

[davesexcel]

http://www.mvps.org/dmcritchie/excel/insrtrow.htm

This site might help you out