Search code examples
excelvbacopypasteexcel-tables

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


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.


Solution

  • 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