Move row to another table when text entered into column

[MinniMaz]

I have the following code to move a row from one table to another table in the same workbook when specific text is entered in to column J. This is working fine, except it does not extend the table in the destination sheet, just adds it to the end and the existing formulas do not auto populate in the destination table. I understand this may have something to do with pasting an entire row. How do I reword this to be able to extend the table in the destination sheet?

Sub MoveBasedOnValue()

'Created by Excel 10 Tutorial
    Dim xRg As Range
    Dim xCell As Range
    Dim A As Long
    Dim B As Long
    Dim C As Long
    A = Worksheets("PENDING").UsedRange.Rows.Count
    B = Worksheets("INVOICE").UsedRange.Rows.Count
    If B = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("INVOICE").UsedRange) = 0 Then B = 0
    End If
    Set xRg = Worksheets("PENDING").Range("J1:J" & A)
    On Error Resume Next
    Application.ScreenUpdating = False
    For C = 1 To xRg.Count
        If CStr(xRg(C).Value) = "Completed" Then
            xRg(C).EntireRow.Copy Destination:=Worksheets("INVOICE").Range("A" & B + 1)
            xRg(C).EntireRow.Delete
            If CStr(xRg(C).Value) = "Completed" Then
                C = C - 1
            End If
            B = B + 1
        End If
    Next

Thanks.

 

[Muhammad_Usman]

Sub MoveBasedOnValue()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim xRg As ListObject
    Dim xDestRg As ListObject
    Dim xCell As Range
    Dim A As Long
    Dim B As Long

    ' Set references to the source and destination worksheets
    Set wsSource = ThisWorkbook.Sheets("PENDING")
    Set wsDest = ThisWorkbook.Sheets("INVOICE")

    ' Set references to the source and destination tables
    Set xRg = wsSource.ListObjects("Table1") ' Replace "Table1" with the actual name of your source table
    Set xDestRg = wsDest.ListObjects("Table2") ' Replace "Table2" with the actual name of your destination table

    A = xRg.ListRows.Count
    B = xDestRg.ListRows.Count

    On Error Resume Next
    Application.ScreenUpdating = False

    ' Loop through the source table
    For Each xCell In xRg.ListColumns("Status").DataBodyRange
        If xCell.Value = "Completed" Then
            ' Add a new row to the destination table
            xDestRg.ListRows.Add
            B = B + 1
            ' Copy the data (except for the formulas) from the source table to the destination table
            xRg.ListRows(xCell.Row - xRg.ListObject.HeaderRowRange.Row).Range.Copy
            xDestRg.ListRows(B).Range.PasteSpecial xlPasteValues
            ' Delete the original row in the source table
            xRg.ListRows(xCell.Row - xRg.ListObject.HeaderRowRange.Row).Delete
        End If
    Next xCell

    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

Test this one

 

[Peter_SSs]

@MinniMaz

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.

I also note that you also did not act on the suggestion here.
You will get better help from the forum if you provide the information requested.

 

[MinniMaz]

Sub MoveBasedOnValue()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim xRg As ListObject
    Dim xDestRg As ListObject
    Dim xCell As Range
    Dim A As Long
    Dim B As Long

    ' Set references to the source and destination worksheets
    Set wsSource = ThisWorkbook.Sheets("PENDING")
    Set wsDest = ThisWorkbook.Sheets("INVOICE")

    ' Set references to the source and destination tables
    Set xRg = wsSource.ListObjects("Table1") ' Replace "Table1" with the actual name of your source table
    Set xDestRg = wsDest.ListObjects("Table2") ' Replace "Table2" with the actual name of your destination table

    A = xRg.ListRows.Count
    B = xDestRg.ListRows.Count

    On Error Resume Next
    Application.ScreenUpdating = False

    ' Loop through the source table
    For Each xCell In xRg.ListColumns("Status").DataBodyRange
        If xCell.Value = "Completed" Then
            ' Add a new row to the destination table
            xDestRg.ListRows.Add
            B = B + 1
            ' Copy the data (except for the formulas) from the source table to the destination table
            xRg.ListRows(xCell.Row - xRg.ListObject.HeaderRowRange.Row).Range.Copy
            xDestRg.ListRows(B).Range.PasteSpecial xlPasteValues
            ' Delete the original row in the source table
            xRg.ListRows(xCell.Row - xRg.ListObject.HeaderRowRange.Row).Delete
        End If
    Next xCell

    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

Test this one

Thank you. However, It is doing the same thing. It is not extending the table, or the formulas within that table. When I manually type into the next row the table extends automatically, however copying and pasting with VBA does not seem to work.

 

[MinniMaz]

@MinniMaz

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.

I also note that you also did not act on the suggestion here.
You will get better help from the forum if you provide the information requested.

Hi Peter,

I will amend my post, once I figure out how

 

[Peter_SSs]

Thanks for updating your profile details.

I will amend my post, once I figure out how

If you review my previous post, you will see that I have already amended your post.