Loop Through column and copy values to other sheet when values are not zero vba excel

Question

I need to write a macro that loops over a column (lets say A) in the last worksheet of the worbook and copies the values in the cell into the same position (so if the first value is in A1, also A1) in another worksheet if they are not 0. I already managed to write some code but I am struggling with setting the range for the range that I am looping for. Help is much appreciated.

Sub tableonlycopywhen0()

Dim Cell As Range, cRange As Range
Dim wsDestination As Worksheet, wsSource As Worksheet
    
    'set worksheets
    With ThisWorkbook
        Set wsSource = .Worksheets(Sheets.Count)
        Set wsDestination = .Worksheets("Overview")
    End With
    

LastRow1 = Sheets(Sheets.Count).Cells(Rows.Count, "A").End(xlUp).Row
Set cRange = Sheets(Sheets.Count).Range(Sheets(Sheets.Count).Cells("A1:A" & LastRow1))
    For Each Cell In cRange
     If Cell.Value > 0 Then
        Cell.Copy
        Sheets("Overview").Select
        lastRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
        wsDestination.Rows(lastRow).PasteSpecial Paste:=xlPasteValues
    End If
    
    Next Cell
    
End Sub

Answer 1

You have already established wsSource, no need to repeat it. Also no need to copy, select and paste when you can make the cells equal.

Sub tableonlycopywhen0()
    
    Dim Cell As Range, cRange As Range
    Dim wsDestination As Worksheet, wsSource As Worksheet
        
        'set worksheets
        With ThisWorkbook
            Set wsSource = .Worksheets(Sheets.Count)
            Set wsDestination = .Worksheets("Overview")
        End With
        
    
    LastRow1 = wsSource.Cells(Rows.Count, "A").End(xlUp).Row
    Set cRange = wsSource.Range(wsSource.Cells(1,1),wsSource.Cells(LastRow1,1))
        For Each Cell In cRange
         If Cell.Value > 0 Then
            lastRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
            wsDestination.Cells(lastRow,1)=Cell.Value
        End If
        
        Next Cell
        
    End Sub

Answer 2

you wrote: and copies the values in the cell into the same position

this code run as you ask:

Sub tableonlycopywhen1()
    
    Dim Cell As Range, cRange As Range, lrw As Long
    Dim wsDestination As Worksheet, wsSource As Worksheet
        
        'set worksheets
        With ThisWorkbook
            Set wsSource = .Worksheets(Sheets.Count)
            Set wsDestination = .Worksheets("Overview")
        End With
        
    
    LastRow1 = wsSource.Cells(Rows.Count, "A").End(xlUp).Row
    Set cRange = wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(LastRow1, 1))
    For Each Cell In cRange.Cells
        If Cell.Value > 0 Then wsDestination.Cells(Cell.Row, Cell.Column) = Cell.Value
    Next Cell
        
End Sub