Search code examples
excelvbaexcel-tableslistobject

Copy not copying to correct column


I cannot figure out why when I execute the copy it always pastes the results to column 3 and not col 1?

I also tried VisRange.Copy Destination:=wst.range("a" & MsfT_LastRow)

Thanks in advance

 ' Get work sheet
    Set wsf = Sheets("TASK - Map and Validation")
    Set wst = Sheets("MASTER - Supplier File")
    
    ' Get table
    Set tblMSFT = wst.ListObjects("MSF_Table")
    Set tblMAV = wsf.ListObjects("MAV_Table")
   
'=====================================================================================
        ' Get the last data row in Map and Validation Table
    
    With tblMSFT.Range
        MsfT_LastRow = .Cells(.Cells.Count).Row
    End With
    
'=====================================================================================
     ' Filter table
    tblMAV.Range.AutoFilter Field:=1, Criteria1:="New"
    
    
    ' Copy filtered table
    Set VisRange = tblMAV.DataBodyRange.SpecialCells(xlCellTypeVisible)
    Set VisRange = Application.Intersect(VisRange, wsf.Columns("B:R"))
    
    If MsfT_LastRow = 2 Then
    VisRange.Copy Destination:=wst.Range("a2")
    Else
    MsfT_LastRow = MsfT_LastRow + 1
    VisRange.Copy Destination:=wst.Cells(MsfT_LastRow, 1)
    End If

Solution

  • Copy Data From One Table to Another

    enter image description here

    • It is assumed that neither table is filtered.
    Sub CopyTableData()
    
        Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
        
        ' Reference the tables.
        
        Dim sws As Worksheet: Set sws = wb.Sheets("TASK - Map and Validation")
        Dim slo As ListObject: Set slo = sws.ListObjects("MAV_Table")
        Dim dws As Worksheet: Set dws = wb.Sheets("MASTER - Supplier File")
        Dim dlo As ListObject: Set dlo = dws.ListObjects("MSF_Table")
        
        ' Reference the source range ('srg').
        
        Dim scrg As Range, svrg As Range, srg As Range
        
        With slo
            Set scrg = .DataBodyRange.Resize(, 17).Offset(, 1)
            ' 17 columns in 'B:R'; 1 column to the right (of 'A') is 'B'.
            
            .Range.AutoFilter Field:=1, Criteria1:="New"
            
            On Error Resume Next
                Set svrg = .DataBodyRange.SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            
            .AutoFilter.ShowAllData
        End With
        
        If svrg Is Nothing Then Exit Sub ' no filtered rows
        
        Set srg = Intersect(svrg, scrg)
        
        ' Reference the first destination cell ('dfcell').
        
        Dim dfcell As Range
        
        With dlo.Range
            If dlo.ListRows.Count = 0 Then ' empty table
                Set dfcell = .Cells(1).Offset(1)
            Else
                Set dfcell = .Cells(1).Offset(.Rows.Count)
            End If
        End With
        
        srg.Copy dfcell
        
        MsgBox "Table data copied.", vbInformation
        
    End Sub