Duplicate the current row automatically
- Nov. 4, 2015
|Example files with this article:|
Today I would like to show you a macro that I use every day, several times. With that macro you can duplicate the currently selected row in an Excel worksheet. This macro not only works in a regular Excel worksheet, but also when the active cell is part of an Excel table (ListObject). The big advantage is that you can quickly copy a row and change where needed.
Here are examples:
We click at cell C7, for example, because every cell in the row is fine for the macro. After that a macro will take row 7 and copy it by inserting as a new row below the currently selected row 7. The explanation is not easy but I bet the screenshots are clear.
Following the text is the VBA code, but you can also see the code in the example file at the top of the page. You will notice in the code that I test whether the selection (active cell) is part of a ListObject ir not. If yes, the code is less straightforward.
Sub DuplicateRow()' Wim Gielis ' http://www.wimgielis.comDim lRow As Long Dim li As ListObject Dim rngStart As Range If TypeName(Selection) = "Range" Then Set rngStart = Selection.Cells(1) lRow = rngStart.Row If lRow < Rows.Count Then Application.ScreenUpdating = False If rngStart.ListObject Is Nothing Then 'non-data table case '==> duplicate the selected row Rows(lRow).Copy Rows(lRow + 1).Insert Shift:=xlDown Rows(lRow + 1).RowHeight = Rows(lRow).RowHeight rngStart.Offset(1).Select Else 'data table case Set li = rngStart.ListObject If li.SourceType = xlSrcRange Then 'turn off filters if applicable If li.AutoFilter.FilterMode Then li.AutoFilter.ShowAllData End If If li.DataBodyRange Is Nothing Then 'a data table without records '==> insert 2 records li.ListRows.Add AlwaysInsert:=True li.ListRows.Add AlwaysInsert:=True Else 'a data table with at least 1 record '==> duplicate the selected row Application.DisplayAlerts = False 'add a row and copy the contents li.ListRows.Add(lRow - li.DataBodyRange.Row + 2).Range.FillDown Rows(lRow + 1).RowHeight = Rows(lRow).RowHeight rngStart.Offset(1).Select Application.DisplayAlerts = True End If Else MsgBox "This Table has a SourceType = " & li.SourceType & ", which is not supported in this macro." & vbNewLine & vbNewLine & _ Replace(Replace("0_NO SUPPORT_External data source (Microsoft SharePoint Foundation site)_(xlSrcExternal)|" & _ "1_SUPPORT__Range_(xlSrcRange)|2_NO SUPPORT_XML_(xlSrcXml)|3_NO SUPPORT_Query_(xlSrcQuery)|4_NO SUPPORT_PowerPivot Model_(xlSrcModel)", _ "|", vbNewLine), "_", vbTab), vbInformation End If End If Application.ScreenUpdating = True End If End IfEnd Sub
Personal macro workbook
As said above, I use this macro a lot, that's why I added a shortcut key to launch it (Ctrl + e) and why I added the macro to my personal macro workboek. Use this macro if you find it useful !