VBA: Copy/Paste Table Rows; For Loops and If/Then Statements but the code doesn't care!

[Tarkemelion]

Hi All,

I have what I thought would be a simple copy/paste macro which appears to ignore my attempts to put a constraint on it. I'm sure there is something I am missing but I can't seem to spot it. Any help would be appreciated!

Ideally the code looks at Table 2 and checks the column in the 16th position. If that number is not a 0 (+/- integers allowed) then I want to copy that row and paste it into the empty Table 6. If the value is a zero then I want to skip that row and move on to the next.
Eventually I will add a line to clear Table 6 each time the Macro is run but perhaps that is for another day.

Sub Copy_Paste()

    Dim i, iLastRow As Integer
    Dim srcRow As Range
    
    Set tbl2 = Worksheets("Cost").ListObjects("Table2")
    Set tbl6 = Worksheets("Not Costs").ListObjects("Table6")
        
    iLastRow = tbl2.ListRows.Count
    
    For i = 1 To iLastRow
        If tbl2.Range.Cells(i, 16).Value <> 0 Then
            Set srcRow = tbl2.ListRows(i).Range
            tbl6.ListRows.Add
            srcRow.Copy
            tbl6.ListRows(i).Range.PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
    Next

End Sub

Additional style points will be warded for...well...style!

 

[igold]

How about these two codes. The first code is your first requirement, the second code is the requirement to clear Table 6.

Sub Copy_Paste()

    Dim tbl2 As ListObject, tbl6 As ListObject
    Dim wsC As Worksheet: Set wsC = Worksheets("Cost")
    Dim wsNC As Worksheet: Set wsNC = Worksheets("Not Costs")
    Dim i, iLastRow As Integer
    Dim srcRow As Range
    
    Set tbl2 = wsC.ListObjects("Table2")
    Set tbl6 = wsNC.ListObjects("Table6")
        
    iLastRow = tbl2.ListRows.Count
    For i = 1 To iLastRow
        If tbl2.DataBodyRange.Cells(i, 16).Value <> 0 Then
            Set srcRow = tbl2.ListRows(i).Range
            If Not tbl6.DataBodyRange(1, 1) = "" Then
                tbl6.ListRows.Add AlwaysInsert:=True
            End If
            srcRow.Copy
            tbl6.ListRows(tbl6.ListRows.Count).Range.PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
    Next

End Sub

Sub ResetTable()

    Dim tbl6 As ListObject
    
    Set tbl6 = Worksheets("Not Costs").ListObjects("Table6")
        With tbl6.DataBodyRange
            If .Rows.Count > 1 Then
                .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
            End If
        End With
    tbl6.DataBodyRange.Rows(1).ClearContents

End Sub

 

[Tarkemelion]

How about these two codes. The first code is your first requirement, the second code is the requirement to clear Table 6.

Sub Copy_Paste()

    Dim tbl2 As ListObject, tbl6 As ListObject
    Dim wsC As Worksheet: Set wsC = Worksheets("Cost")
    Dim wsNC As Worksheet: Set wsNC = Worksheets("Not Costs")
    Dim i, iLastRow As Integer
    Dim srcRow As Range
   
    Set tbl2 = wsC.ListObjects("Table2")
    Set tbl6 = wsNC.ListObjects("Table6")
       
    iLastRow = tbl2.ListRows.Count
    For i = 1 To iLastRow
        If tbl2.DataBodyRange.Cells(i, 16).Value <> 0 Then
            Set srcRow = tbl2.ListRows(i).Range
            If Not tbl6.DataBodyRange(1, 1) = "" Then
                tbl6.ListRows.Add AlwaysInsert:=True
            End If
            srcRow.Copy
            tbl6.ListRows(tbl6.ListRows.Count).Range.PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
    Next

End Sub

Sub ResetTable()

    Dim tbl6 As ListObject
   
    Set tbl6 = Worksheets("Not Costs").ListObjects("Table6")
        With tbl6.DataBodyRange
            If .Rows.Count > 1 Then
                .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
            End If
        End With
    tbl6.DataBodyRange.Rows(1).ClearContents

End Sub

I made some minor adjustments but the foundation works! Thanks for that and to the victor goes the style points!

 

[igold]

You're welcome. I was happy to help. Thanks for the feedback and style points.