Macro: insert rows anywhere in the sheet

[excel]

I'm rather new to macro-programming...

I want a macro to insert blank rows beneath the active row (or cell) and
then copy the active row to the first blank row beneath the row with
content. By using "Register macro" I have made a macro like this:
Sub Makro1()
'
' Makro1 Makro
'
' Hurtigtast: CTRL+m
'
Rows("6:10").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("5:5").Select
Selection.Copy
Rows("6:6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub


The problem is that if the cursor is pointing at for instance row 12, and I
activate the macro by ctrl+m, the blank rows still are inserted beneath row
5, not beneath row 12.

Kjell

 

[Dave Peterson]

You may want to look at David McRitchie's site:
http://www.mvps.org/dmcritchie/excel/insrtrow.htm
look for: InsertRowsAndFillFormulas

 

[Roger Govier]

Hi

Try

Sub Makro1()

' Makro1 Makro
' Hurtigtast: CTRL+m
Dim ar As Long
ar = ActiveCell.Row
Rows(ar & ":" & ar + 4).Insert Shift:=xlDown, _
CopyOrigin:=xlFormatFromLeftOrAbove
Rows(ar - 1).Copy Rows(ar)
Application.CutCopyMode = False
End Sub


--

Regards
Roger Govier

I'm rather new to macro-programming...

I want a macro to insert blank rows beneath the active row (or cell) and
then copy the active row to the first blank row beneath the row with
content. By using "Register macro" I have made a macro like this:
Sub Makro1()
'
' Makro1 Makro
'
' Hurtigtast: CTRL+m
'
Rows("6:10").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("5:5").Select
Selection.Copy
Rows("6:6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub


The problem is that if the cursor is pointing at for instance row 12, and
I activate the macro by ctrl+m, the blank rows still are inserted beneath
row 5, not beneath row 12.

Kjell


__________ Information from ESET Smart Security, version of virus
signature database 5228 (20100625) __________

The message was checked by ESET Smart Security.

http://www.eset.com

__________ Information from ESET Smart Security, version of virus signature database 5228 (20100625) __________

The message was checked by ESET Smart Security.

http://www.eset.com

 

[Kjell Blomseth]

Thanks Roger. That solved my problem!

Kjell

Hi

Try

Sub Makro1()

' Makro1 Makro
' Hurtigtast: CTRL+m
Dim ar As Long
ar = ActiveCell.Row
Rows(ar & ":" & ar + 4).Insert Shift:=xlDown, _
CopyOrigin:=xlFormatFromLeftOrAbove
Rows(ar - 1).Copy Rows(ar)
Application.CutCopyMode = False
End Sub


--

Regards
Roger Govier



__________ Information from ESET Smart Security, version of virus
signature database 5228 (20100625) __________

The message was checked by ESET Smart Security.

http://www.eset.com

 

[GS]

Here's a generic proc you can modify to suit or keep as a reusable
utility:

Public Sub InsertBlankRows(Optional Position As String)
' Inserts a specified number of rows at the location specified.
' If the Position arg is not used then the default is ActiveCell.Row.

Dim vRows As Variant, lPos As Long
Const sMsg As String = "Enter the number of rows to insert."

'Evaluate user input
On Error Resume Next
vRows = InputBox(Prompt:=sMsg, Default:=1)
If vRows = "" Then Exit Sub '//user cancels
If Not Err = 0 Or _
Not IsNumeric(vRows) Or _
Not vRows >= 1 Then Exit Sub

'Get the position to insert
lPos = ActiveCell.Row
If Position = "Below" Then lPos = lPos + 1

'Insert the rows
Cells(lPos, 1).Resize(vRows).Insert Shift:=xlDown
Application.CutCopyMode = False
End Sub