copy data greater than 0

[ymdeek]

hello

I am new to macro and I need your help to create a macro that copy only the data with value > 0 to a new workbook. As you can see from the table, some data have no value so I am trying to avoid copying them by using if condition. Any one can help?

see image here

https://ibb.co/ettTnx

Note: ignore the zeros in Country

 

[ranman256]

in my example the macro runs down Col A (no nulls) until the end (null cell)
it checks the value of kMyCOL (col 4, but offset from 1) for the zero, if not zero , then it copies.
alter these for your workbook. change Const kMyCOL = 3

Public Sub CopyNonZeros()
Dim wbSrc As Workbook, wbTarg As Workbook
Const kMyCOL = 3


    'copy headers
Set wbSrc = ActiveWorkbook
Rows("1:1").Select
Selection.Copy
Workbooks.Add
Set wbTarg = ActiveWorkbook
ActiveSheet.Paste
Range("A2").Select


wbSrc.Activate
Range("A2").Select
While ActiveCell.Value <> ""
   Select Case ActiveCell.Offset(0, kMyCOL).Value
      Case ""
        GoSub CopyRow
      Case 0
      Case Else
        GoSub CopyRow
   End Select
   
   NextRow
Wend


Set wbSrc = Nothing
Set wbTarg = Nothing
Exit Sub


CopyRow:
'----------
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select
Selection.Copy
wbTarg.Activate
ActiveSheet.Paste
NextRow
wbSrc.Activate
Return
End Sub


Private Sub NextRow()
ActiveCell.Offset(1, 0).Select
End Sub