Microsoft Office Forums - View Single Post - [Solved] Move entire rows from one table to another table

Guessed · 11-10-2021, 04:42 AM

This code should work if your selection is of complete table rows. It also works with discontinuous selections.

Code:

Sub MoveARow()
  Dim activeListCells As Range, aLO As ListObject, aLO2 As ListObject
  
  Set aLO = ActiveWorkbook.Sheets("ForEdit").ListObjects("tForEdit")
  Set aLO2 = ActiveWorkbook.Sheets("Edited").ListObjects("tEdited")
  Set activeListCells = Intersect(aLO.DataBodyRange, Selection)
  If activeListCells Is Nothing Then
    MsgBox "List row not selected"
  Else              'assumes the selection is of complete table rows
    aLO2.ListRows.Add
    activeListCells.Copy aLO2.ListRows(aLO2.ListRows.Count).Range.Cells(1, 1)
    activeListCells.Delete
  End If
End Sub