VBA to copy cells if value greater than 0 and paste to another worksheet

[asimr]

Hi all,

Really need your help, I apologise for my lack in knowledge but really trying

I am trying to edit some code, to copy cells if the value is greater than 0

So if there is a value in worksheet "inventory" column A to copy cells A1 A2 A3 onto
Worksheet "Sales Invoice" cells A16 and down F16 down and G16 down.

I am really not explaining this well, but I have seen some code on another forum with a similar question which is kind of what i was hoping but it place the values at the bottom and pretty much doesnt do what i was hoping

Sub Button3_Click()
Dim rng As Range
Dim cell As Range
Dim lr As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Sheets("Inventory")
Set ws2 = Sheets("Sales Invoice")


lr = ws1.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws1.Range("H1:H" & lr)


For Each cell In rng
If cell.Value > 0 Then
cell.EntireRow.Copy
If ws2.Range("A1").Value = "" Then
ws2.Range("A1").PasteSpecial xlPasteValues
Else
ws2.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End If
End If
Next cell


Application.CutCopyMode = False
Range("A1").Select
End Sub

 

[asimr]

Sub Button3_Click()

Dim tfCol As Range, Cell As Object

Set tfCol = Range("A2:A5") 'Substitute with the range which includes your True/False values

For Each Cell In tfCol


If Cell.Value >= 0 Then
Cell.EntireRow.Copy
Worksheets("Sales Invoice").Select 'Substitute with your sheet
ActiveSheet.Range("A65536").End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
End If

Next


End Sub

This slightly works, but pastes the values at the bottom rather from Row 16

 

[JoeMo]

This is not efficient code, but see if it works for you. Would need some more details from you to make it more efficient.

Sub Button3_Click()
Dim tfCol As Range, Cell As Object
Set tfCol = Range("A2:A5") 'Substitute with the range which includes your True/False values
For Each Cell In tfCol
    If Cell.Value >= 0 Then
    Cell.EntireRow.Copy
    Worksheets("Sales Invoice").Select 'Substitute with your sheet
    If Range("A16") = "" Then
        Range("A16").Select
        ActiveSheet.Paste
    Else
        Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select
        ActiveSheet.Paste
    End If
Next
End Sub