Excel-VBA: Add Multiple Rows to Table with Data from different sheet

Question

I am trying to add rows to a table on one worksheet with data from a different sheet. The below code is working to an extent.

I am able to have it add in one row of data at a time, as well as determine where the data is added to the table. However, I would like it to add in multiple rows of data, while still being able to determine where in the table it will be added.

I've tried different variations of achieving this process, however, they all seem to have an issue. Either I can insert multiple rows, but can't determine where in the table they go, or I haven't been able to add multiple rows at one time.

Sub AddData()
 
    Dim ws As Worksheet
    Dim tbl As ListObject
    Dim NewRow As ListRow
        
        Set ws = ActiveWorkbook.Worksheets("DATA Member-19")
        Set tbl = ws.ListObjects("MemberInfo19")
        Set NewRow = tbl.ListRows.Add
            
            With NewRow
              .Range(1) = Sheets("Add Members").Range("B4")
            End With
End Sub

The range for the new row would start at B4 and would change depending on how much data needs to be added. It could be only one row, but it could also be several rows of data that needs to be transferred over.

score 0 · Answer 1 · answered Jun 24 '22 at 14:26

I am assuming you are actually working with 2 tables (?) and want to move/copy the data from Table1 to Table2 given that it matches a search criteria or Member number input? Try the following code:

    Sub MoveMemberData()
 
    Dim SearchCell As Range
    Dim T1row As Long       'Row count Table1
    Dim T2row As Long       'Row count Table2
    Dim SearchRow As Long   'Searchrow count
    Dim DataRow As Long     'Use later to delete records on Table 1 if required
     
    Dim Tbl1 As ListObject, Tbl2 As ListObject
   
    Set Tbl1 = MySheet1.ListObjects("MyTable1")
    Set Tbl2 = MySheet2.ListObjects("MyTable2")
  
    T1row = Worksheets("MySheet1").UsedRange.Rows.Count
    T2row = Worksheets("MySheet2").UsedRange.Rows.Count

    If T2row = 0 Then
       If Application.WorksheetFunction.CountA(Worksheets("MySheet2").UsedRange) = 0 Then T2row = 0
    End If
  
    Set SearchCell = Worksheets("MySheet1").Range("B4:B" & T1row)

    On Error Resume Next
    Application.ScreenUpdating = False
    
    For SearchRow = 1 To SearchCell.Count   
        If CStr(SearchCell(SearchRow).Value) = "MemberInfo19" Then 
            T2row = T2row + 1
            Tbl2.ListRows.Add.Range.Value = Tbl1.ListRows(SearchRow).Range.Value
        End If
    Next
' Add this next loop to go through  Tbl1 and delete the rows you copied (if its required) 
 For DataRow = 1 To SearchCell.Count
        If CStr(SearchCell(DataRow).Value) = "MemberInfo19" Then
            Tbl1.ListRows(DataRow).Delete
            DataRow = DataRow - 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Excel-VBA: Add Multiple Rows to Table with Data from different sheet

1 Answers1