Copy not copying to correct column

116 views Asked by At

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
2

There are 2 answers

8
VBasic2008 On BEST ANSWER

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
6
Siddharth Rout On

Is this what you are trying (UNTESTED)?

'~~> 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
MsfT_LastRow = tblMSFT.Range.Cells(tblMSFT.Range.Cells.Count).Row

'~~> 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"))

With tblMSFT
    .HeaderRowRange.Offset(Application.Max(1, .ListRows.Count + 1),2).Value = VisRange.Value
End With