VBA - Filter, Copy and Paste Visible Columns If Cell has Value

Hey guys,

I need help.

What I want is basically for the macro to filter copy and paste visible columns only if a cell has a Value greater than 0.
I tried this formula, however when I played it step-by-step, it seems like its filtering, copy and pasting even if the value is 0.
What did I do wrong?

Thanks in advance!!

Dim num As Integer
num = 1
For Each i In Range("A1:G1")
If i.Value > 0 Then
ActiveSheet.Range("$A$1:$G$300").AutoFilter Field:=5, Criteria1:="<>"
Else
If i.Value = 0 Then
End If
End If
Next i

Range("A2:A65536").SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet1").Select
Destination = Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Sheets("Sheet2").Select

Are trying to only filter column E for numbers greater than 0 or all columns?

All columns, but the filter criteria would be non-blank cells of column E

Basically what its supposed to do is:

Check the value of E1.
If E1 > 0, then Filter all columns using non blank cells of column E
Once filtering is done, copy visible cells of colum A and E to sheet 2

However, if E1=0, then do nothing

Hello there try replacing you existing code between the Sub and End Sub with the following:

Dim LR As String    'declare variable

With Sheets("Sheet2")   'with the worksheet sheet2
    LR = .Range("A6555").End(xlUp).Row  'LR is equal to the last cell in column A that contains a value
        If .Range("E1").Value > 0 Then  'if cell E1 is greater than 0 then
            With .Range("A1:E" & LR)    'with range A1 through E and the last row
                .AutoFilter 'autofilter
                .AutoFilter Field:=1, Criteria1:="<>"   'filter out blanks from column A
                .AutoFilter Field:=2, Criteria1:="<>"   'filter out blanks from column B
                .AutoFilter Field:=3, Criteria1:="<>"   'filter out blanks from column C
                .AutoFilter Field:=4, Criteria1:="<>"   'filter out blanks from column D
                .AutoFilter Field:=5, Criteria1:="<>"   'filter out blanks from column E
            End With
        
            .Range("A2:E" & LR).SpecialCells(xlCellTypeVisible).Select  'select the filtered cells from the range
                Selection.Copy  'copy the filtered cells
                    With Sheets("Sheet1")   'with the worksheet Sheet1
                        .Range("A" & .Range("A6555").End(xlUp).Row + 1).PasteSpecial    'paste the copied values into the first empty row
                    End With
        End If
            With .Range("A1:E" & LR)    'with the range
                .AutoFilter 'clear the filter
            End With

.Range("A1").Select 'select cell A1
       
End With

Application.CutCopyMode = False

Anything that appears in green is a comment meant to help you understand the code.

It works! Thanks!!! = )=)

@ gurlygal

Based on your last post it seems that you are satisfied with the solution(s) you've received but you haven't marked your thread as SOLVED. I'll do that for you now but please keep in mind for your future threads that Rule #9 requires you to do that yourself. If your problem has not been solved you can use Thread Tools (located above your first post) and choose "Mark this thread as unsolved".
Thanks.

Also, as a new member of the forum, you may not be aware that you can thank those who have helped you by clicking the small star icon located in the lower left corner of the post in which the help was given. By doing so you can add to the reputation(s) of those who helped.

Glad to hear it! As Cutter stated, please don't forget to mark your thread solved and maybe give a little star tap if I helped.

Thanks!