How to copy from a cell and paste in a new row of a different table VBA

Question

I am trying to do the following:

1. Check each row if "Order" column is empty in table1 from sheet1 (there is only one table in this sheet)
2. if it is "Order" column is empty, copy the "Notification" number from the same row AND then paste it into a new row of a table (table2) in another sheet (sheet2) under column "Notification".
3. if it is not empty, go to the next row in table1

I have the following code so far:

For Each TCell in Range ("Table1").ListObject.ListColumns("Order").DataBodyRange.Cells
    If TCell.Value="" then
    Table2.ListRows.Add AlwaysInsert:=True
    Range(TCell.Row, "Notification").Copy Range("Table2") .ListObject. ListColumns ("Notification" 
    .DataBodyRange.End(xlDown).Offset (1,0)
    End if
Next TCell

Any help would be greatly appreciated! Thanks.

Answer 1

Append Table's Column to Another Table's Column

• This is a basic solution that 'literally' does what is required (slow). By using object variables, it illustrates their application.
• You could increase efficiency by introducing arrays, or especially by using AutoFilter.

Option Explicit

Sub AppendNotifications()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Sheet1")
    Dim stbl As ListObject: Set stbl = sws.ListObjects("Table1")
    Dim slcl As ListColumn: Set slcl = stbl.ListColumns("Order")
    Dim svcl As ListColumn: Set svcl = stbl.ListColumns("Notification")
    
    Dim scOffset As Long: scOffset = svcl.Index - slcl.Index

    Dim dws As Worksheet: Set dws = wb.Worksheets("Sheet2")
    Dim dtbl As ListObject: Set dtbl = dws.ListObjects("Table2")
    Dim dvcl As ListColumn: Set dvcl = dtbl.ListColumns("Notification")
    
    Dim dvCol As Long: dvCol = dvcl.Index
    
    Dim sCell As Range
    Dim dvrw As ListRow
    
    For Each sCell In slcl.DataBodyRange
        If Len(sCell.Value) = 0 Then
            Set dvrw = dtbl.ListRows.Add
            dvrw.Range(dvCol).Value = sCell.Offset(, scOffset).Value
        End If
    Next sCell
    
    MsgBox "Notifications appended.", vbInformation

End Sub

Answer 2

Could try below codes:

Sub transform()
    Dim cell        As Range
    Set rng1 = Sheet1.Range("Table1[Order]")
    Set SheetTwo = ActiveWorkbook.Worksheets("Sheet2")
    Set TableTwo = SheetTwo.ListObjects("Table2")
        
    For Each cell In rng1
        
        If Not IsEmpty(cell.Offset(0, 0).Value) Then
            Dim newrow As ListRow
            Set newrow = TableTwo.ListRows.Add
            With newrow
                .Range(1) = cell.Offset(0, 1).Value
            End With
        End If
        
    Next cell
End Sub

Codes are self-explanatory.

Notes: Table2 only has a column.