Macro to copy paste rows if cell value greater than 0

[mike7990]

I have multiple worksheets and I want to copy all rows where the value of range (O6:O75 is greater than 0 and paste it in a single new sheet.
Preferable in the order of the sheets mentioned below.
I have the following sheets:
LF
CF
XF
XG
XG+

The sheet where I want the rows to be copied to is 'Workflow'
Any help on this?

 

[Z51]

Perhaps this will work for you...

Sub mike()
Dim nextrow As Long, i As Long, ws As Variant
nextrow = Sheets("Workflow").Range("A" & Rows.Count).End(xlUp).Row + 1

'Application.ScreenUpdating = False
For Each ws In Array("LF", "CF", "XF", "XG", "XG+")
    For i = 6 To 75
        If Sheets(ws).Cells(i, 15).Value > 0 Then
            Sheets(ws).Cells(i, 15).EntireRow.Copy Sheets("Workflow").Cells(nextrow, 1)
            nextrow = nextrow + 1
        End If
    Next i
Next ws
'Application.ScreenUpdating = True
End Sub

 

[MARK858]

Maybe try something like the code below

Sub Mike7990()

    Dim ws As Worksheet, wsArr

    wsArr = Array("LF", "CF", "XF", "XG", "XG+")

   Application.ScreenUpdating = False

    For Each ws In ActiveWorkbook.Worksheets(wsArr)
        With ws.Range("O5:O75")
            .AutoFilter 1, ">0", xlAnd
            .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).EntireRow.Copy Sheets("Workflow").Range("A" & Rows.Count).End(xlUp)(2)
            .AutoFilter
        End With
    Next ws

   Application.ScreenUpdating = True
End Sub

 

[mike7990]

Both codes work, amazing job!! Much appreciated! Which one should I pick?

 

[mike7990]

I see it hides alot of rows on the Workflow sheet that don't have a value of >1. Can this be removed somehow? And is it possible that for example, I add a row at sheet 'LF' that has a value greater than 1, the workflow sheet gets updated automatically and this row gets added?

 

[mike7990]

Perhaps this will work for you...

Sub mike()
Dim nextrow As Long, i As Long, ws As Variant
nextrow = Sheets("Workflow").Range("A" & Rows.Count).End(xlUp).Row + 1

'Application.ScreenUpdating = False
For Each ws In Array("LF", "CF", "XF", "XG", "XG+")
    For i = 6 To 75
        If Sheets(ws).Cells(i, 15).Value > 0 Then
            Sheets(ws).Cells(i, 15).EntireRow.Copy Sheets("Workflow").Cells(nextrow, 1)
            nextrow = nextrow + 1
        End If
    Next i
Next ws
'Application.ScreenUpdating = True
End Sub

Your code seems to be the better one, since you don't have those hidden rows on the 'workflow' sheet. Awesome!! Do you think it's possible to make the "workflow' sheet automated so when I add a row at sheet 'LF' that has a value greater than 1 at O6:075, the workflow sheet gets updated automatically and this row gets added to the 'workflow' sheet?

 

[MARK858]

I see it hides alot of rows on the Workflow sheet that don't have a value of >1. Can this be removed somehow?

Neither code hides any rows, both the codes copy the rows with a value greater than zero from the named sheets to the "Workflow" sheet... they do nothing else unless you don't have any values in column A which affects my code, as it uses the cells in column A to determine the cell to copy to.
If that is the case then you will probably find the code below fixes that.

Sub Mike7990A()

    Dim ws As Worksheet, wsArr

    wsArr = Array("LF", "CF", "XF", "XG", "XG+")

    For Each ws In ActiveWorkbook.Worksheets(wsArr)
        With ws.Range("O5:O75")
            .AutoFilter 1, ">0", xlAnd
            .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).EntireRow.Copy Sheets("Workflow").Cells(Sheets("Workflow").Range("O" & Rows.Count).End(xlUp)(2).Row, 1)
            .AutoFilter
        End With
    Next ws
End Sub