Formula or VBA? Copy and paste Table rows.

[somfin4u2c]

I have a sheet that has 4 tables.
Let's say tables are A, B, C, and D.
Table B has columns A-O, if column O has the value of W then copy that row (Column's A-N) and paste to the next available row of table D.

Any help would be greatly appreciated.

 

[Yongle]

what are the names of the 2 tables?
what should trigger the code to run?

 

[somfin4u2c]

what are the names of the 2 tables?
what should trigger the code to run?

Lets call them "Table B" and "Table D", the trigger would be if a W is entered in column O of "Table B"

 

[Yongle]

Those are not the names of your tables

 

[somfin4u2c]

Those are not the names of your tables

The 4 tables are named "TAPB, TAPS, TAPA, TAPG"

Column O in Table "TAPS" the letter W is the trigger to copy Columns A-N and paste to last row of Table "TAPG"

 

[Yongle]

Thanks - will update thread when back at PC later this morning (UK)

 

[Yongle]

Tests on a COPY of your data first

Place code below goes in SHEET code window (not in a Module like Module1)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tapS As ListObject, tapG As ListObject
    Dim Rng As Range, pasteHere As Range
    
    If Target.CountLarge > 1 Then Exit Sub
    Set tapS = Me.ListObjects("TAPS")
    Set tapG = Me.ListObjects("TAPG")
    Set Rng = Intersect(Target, tapS.ListColumns(15).DataBodyRange)

    If Not Rng Is Nothing Then
        If Target = "W" Then
            tapG.ListRows.Add AlwaysInsert:=True
            Set pasteHere = tapG.Range(tapG.ListColumns(1).Range.Rows.Count, 1).Resize(, 14)
            Application.EnableEvents = False
            pasteHere.Value = Me.Cells(Target.Row, "A").Resize(, 14).Value
            Application.EnableEvents = True
        End If
    End If
End Sub

 

[somfin4u2c]

Tests on a COPY of your data first

Place code below goes in SHEET code window (not in a Module like Module1)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tapS As ListObject, tapG As ListObject
    Dim Rng As Range, pasteHere As Range
   
    If Target.CountLarge > 1 Then Exit Sub
    Set tapS = Me.ListObjects("TAPS")
    Set tapG = Me.ListObjects("TAPG")
    Set Rng = Intersect(Target, tapS.ListColumns(15).DataBodyRange)

    If Not Rng Is Nothing Then
        If Target = "W" Then
            tapG.ListRows.Add AlwaysInsert:=True
            Set pasteHere = tapG.Range(tapG.ListColumns(1).Range.Rows.Count, 1).Resize(, 14)
            Application.EnableEvents = False
            pasteHere.Value = Me.Cells(Target.Row, "A").Resize(, 14).Value
            Application.EnableEvents = True
        End If
    End If
End Sub

Thank you it works, one little problem though. I have a total row in table TAPG. Your VBA does paste the data into the total row then a blank row is inserted above the total row. If I turn the total row off, then it works perfectly. Is there a fix for this, if not I am sure I can muddle by without a total row?

 

[Yongle]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tapS As ListObject, tapG As ListObject
    Dim Rng As Range, pasteHere As Range
    
    If Target.CountLarge > 1 Then Exit Sub
    Set tapS = Me.ListObjects("TAPS")
    Set tapG = Me.ListObjects("TAPG")
    Set Rng = Intersect(Target, tapS.ListColumns(15).DataBodyRange)

    If Not Rng Is Nothing Then
        If Target = "W" Then
            tapG.ShowTotals = False
            tapG.ListRows.Add AlwaysInsert:=True
            Set pasteHere = tapG.Range(tapG.ListColumns(1).Range.Rows.Count, 1).Resize(, 14)
            Application.EnableEvents = False
            pasteHere.Value = Me.Cells(Target.Row, "A").Resize(, 14).Value
            Application.EnableEvents = True
            tapG.ShowTotals = True
        End If
    End If
End Sub

 

[somfin4u2c]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tapS As ListObject, tapG As ListObject
    Dim Rng As Range, pasteHere As Range
   
    If Target.CountLarge > 1 Then Exit Sub
    Set tapS = Me.ListObjects("TAPS")
    Set tapG = Me.ListObjects("TAPG")
    Set Rng = Intersect(Target, tapS.ListColumns(15).DataBodyRange)

    If Not Rng Is Nothing Then
        If Target = "W" Then
            tapG.ShowTotals = False
            tapG.ListRows.Add AlwaysInsert:=True
            Set pasteHere = tapG.Range(tapG.ListColumns(1).Range.Rows.Count, 1).Resize(, 14)
            Application.EnableEvents = False
            pasteHere.Value = Me.Cells(Target.Row, "A").Resize(, 14).Value
            Application.EnableEvents = True
            tapG.ShowTotals = True
        End If
    End If
End Sub

Worked perfectly, Thanks for your help!