VBA to insert rows is not keeping cell contents or formula

Stan101

New Member
Joined
Sep 2, 2016
Messages
15
I have code to insert rows. A dialog pops up asking for the number of new rows required. Those rows are then inserted under. I am using "CopyOrigin" which by all accounts if to copy contents, formulas and formatting but it does not seem to be doing so.

Can anyone offer assistance? I would like to new inserted cells to have the same formatting and contents (and in future possibly formulas)

Also, how would you approach selectively copying contents from row above into these new cells.

EG: after adding 4 new rows after row 5, then copy the contents from B5, f5, and g5 to the new rows.

VBA Code:
Sub InsertRows()


' Adds new blank lines based on the quantity added in the dialog box. It keeps formatting and forumlas.



Dim numRows As Integer

Dim counter As Integer


'Select the current row

   ActiveCell.EntireRow.Select

On Error GoTo Last

   numRows = InputBox("Enter number of rows to insert. Rows will be added above the highlighted row.")


'Keep on inserting rows until we reach the desired number

For counter = 1 To numRows

   Selection.Insert Shift:=xlToDown, CopyOrigin:=xlFormatFromRightorAbove

Next counter

  Last: Exit Sub

End Sub
 
Last edited:

Some videos you may like

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,105
Office Version
  1. 2013
Platform
  1. Windows
This might do what you're after
VBA Code:
Sub InsertRows()

    ' Adds new blank lines based on the quantity added in the dialog box. It keeps formatting and forumlas.
    
    Dim numRows     As Long
    Dim raSource    As Range
    Dim bResult     As Boolean
    
    Set raSource = ActiveCell.EntireRow
    numRows = InputBox("Enter number of rows to insert. Rows will be added above the highlighted row.")
    On Error Resume Next
    raSource.Offset(-1, 0).Copy
    bResult = Range(raSource, raSource.Offset(numRows - 1, 0)).EntireRow.Insert(Shift:=xlShiftDown, CopyOrigin:=xlFormatFromLeftOrAbove)
    Application.CutCopyMode = False
    If Not bResult Then
        MsgBox "Inserting rows failed!", vbExclamation
    End If
End Sub
 

Stan101

New Member
Joined
Sep 2, 2016
Messages
15
That works. I will play with it further to see what else I can achieve you you have taught me something new. Thanks.
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,105
Office Version
  1. 2013
Platform
  1. Windows
You are welcome and thanks for letting me know.
 

Watch MrExcel Video

Forum statistics

Threads
1,114,447
Messages
5,547,974
Members
410,820
Latest member
Prepost
Top