Want to insert rows in the middle of a table by pushing down rows below.

[briandeasycorkcityie]

Hi,

I want to copy a fixed range of cells to the location of the active cell with the cell and row properties. I have that part working as below but I want to by able to insert it into the middle of a sheet and push down the rows below so that they don't get overwritten. Can anyone help with this please?

Sub POInsert()
Dim btn As OLEObject, x As Long, y As Long, i As Long
Application.ScreenUpdating = False
y = ActiveCell.Row
Range("A1:M6").Copy Destination:=Cells(y, 1)


For i = 0 To 6
    Rows(y + i).RowHeight = Rows(1 + i).RowHeight
Next i
Application.ScreenUpdating = True
End Sub

 

[NateSC]

You have the copy statement. Just remove the "Destination" and use an "Insert" instead.:

Range("A1:M6").Copy 'Destination:=Cells(y, 1)
Cells(y, 1).Insert xlShiftDown

 

[briandeasycorkcityie]

You have the copy statement. Just remove the "Destination" and use an "Insert" instead.:

Range("A1:M6").Copy 'Destination:=Cells(y, 1)
Cells(y, 1).Insert xlShiftDown

Thank you for that NateSC.