Copy active row and paste as new row in table

Vbanoob98

Board Regular
Joined
Sep 13, 2019
Messages
118
Hi so I have the following code that copies the active row and inserts it as a new row

VBA Code:
    ActiveCell.Rows.EntireRow.Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Rows.EntireRow.Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False

But it seems this wont work with tables. Anyone has an easy solution? I cant seem to figure it out
 

Some videos you may like

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

VBE313

Well-known Member
Joined
Mar 22, 2019
Messages
675
Office Version
  1. 365
Platform
  1. Windows
VBA Code:
Sub VBAnoob98()
Application.ScreenUpdating = False
With Sheets("Sheet1")
    If Not Intersect(ActiveCell, [Table1]) Is Nothing Then
       .ListObjects("Table1").ListRows.Add (ActiveCell.Row)
       .Range(ActiveCell, ActiveCell.End(xlToRight)).Copy
       .Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 0).End(xlToRight)).PasteSpecial
       Application.CutCopyMode = False
    End If
End With
ActiveCell.Select
Application.ScreenUpdating = True
End Sub
 

Vbanoob98

Board Regular
Joined
Sep 13, 2019
Messages
118
Works very well, thank you

Heres another option I found where you can select more than 1 row


VBA Code:
Sub DuplicateRows()

Dim ws As Worksheet
Dim mySel As Range
Dim mySelVis As Range
Dim rngArea As Range
Dim lRowSel As Long
Dim lRowNew As Long
Dim lRowsAdd As Long
Dim myList As ListObject
Dim myListRows As Long
Dim myListCols As Long
Dim c As Range

Dim lAreas As Long
Dim lRowsArea As Long

Set ws = ActiveSheet
Set mySel = Selection.EntireRow
lAreas = Selection.Areas.Count
lRowsArea = Selection.Areas(lAreas).Rows.Count
Set mySelVis = mySel.SpecialCells(xlCellTypeVisible)

lRowSel = mySel.Areas(lAreas).Cells(lRowsArea, 1).Row + 1

For Each rngArea In mySel.Areas
  For Each c In rngArea.Columns(1).Cells
    If Not Intersect(c, mySelVis) Is Nothing Then
      ws.Cells(lRowSel, 1).EntireRow.Insert
    End If
  Next c
Next rngArea

mySel.SpecialCells(xlCellTypeVisible).Copy
ws.Cells(lRowSel, 1).PasteSpecial Paste:=xlPasteAll

Application.CutCopyMode = False
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,672
Messages
5,597,488
Members
414,146
Latest member
marginmakerb

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top