Forum Discussion
VBA Macro - Add table row and paste
Hello all,
I am a vba newbie and have found a code that helps to archive data when it is switched to completed. It all works well, but for the paste aspect of it I want it to add a row to the bottom of a table (I have yet to create) and paste it there. Not sure how to go about and tweak the code to add this function so any help would be greatly appreciated!
Here is the current code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tbl As ListObject
Dim rng As Range
Dim dws As Worksheet
Dim dlr As Long
Application.ScreenUpdating = False
On Error GoTo Skip
Set tbl = ActiveSheet.ListObjects("Table1")
If Not Intersect(Target, tbl.DataBodyRange.Columns(21)) Is Nothing Then
Application.EnableEvents = False
Set rng = Intersect(ActiveSheet.Rows(Target.Row), Columns("A:AJ"))
rng.Copy
Select Case Target.Value
Case "Yes"
Set dws = ThisWorkbook.Worksheets("Completed RCD Orders")
End Select
dlr = dws.Cells(Rows.Count, "D").End(xlUp).Row + 1
dws.Range("A" & dlr).PasteSpecial xlPasteValues
rng.Delete
End If
Skip:
Application.CutCopyMode = 0
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
2 Replies
- Update: I added a table and got it to paste in a table, just need it to add a row and paste in that row.
Here is updated code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tbl As ListObject
Dim rng As Range
Dim dws As Worksheet
Dim dlr As Long
Dim tblCO As ListObject
Application.ScreenUpdating = False
On Error GoTo Skip
Set tbl = ActiveSheet.ListObjects("Table1")
Set tblCO = Sheet3.ListObjects("CompletedOrders")
If Not Intersect(Target, tbl.DataBodyRange.Columns(21)) Is Nothing Then
Application.EnableEvents = False
Set rng = Intersect(ActiveSheet.Rows(Target.Row), Columns("A:AJ"))
rng.Copy
Select Case Target.Value
Case "Yes"
Set dws = ThisWorkbook.Worksheets("Completed RCD Orders")
End Select
dws.Range(tblCO).PasteSpecial xlPasteValues
rng.Delete
End If
Skip:
Application.CutCopyMode = 0
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub- To only one row copy to the bottom of another sheet,is't it?
Set rng = Intersect(ActiveSheet.Rows(Target.Row), Columns("A:AJ"))
?
copy current entire row?
