Find column that meets Criteria and Copy Row to another Sheet

Question

I'm trying to create a Macro that will find a Value in a column and if a criteria is met, then copies the entire row to another sheet. So far I have failed.

I have a Sheet called "DB" which has all the raw data with headers and it ranges from A to BG. The column that has the values to meet the criteria is "AJ" and it goes from no data (blank cell on AJ) up to number 10.

I have three other sheets where the data will be copied to. "BlankResults", "0to8" and "9to10" (they all have the same headers as "DB")

What I need is for the macro to check on "DB" column "AJ" for the following:

>= 9 then copy the entire row and paste it on the sheet "9to10" 
<= 8 then copy and paste the row on "0to8" 
Blank Cells under AJ and copy the row to "BlankResults".

I know that the blank cells part might be kinda tricky because of the amount of cells empty below the last row and the blank cell on AJ could be anywhere on AJ but just as FYI, the entire row from "A to BG" will have data even if the cell on AJ is blank.

I was going to paste the code I was running but it's rather worthless because it only searches for the ">=9" criteria and copies the row but I can't figure out how to do it all in one single macro, nor how to work around the blank cells on AJ since I still need the row on another sheet.

I'm trying to automate a report which that I need to load to a pivot table and I want to sort the data needed since I have to do lots of calculations based on the criterias mentioned above.

If you need me to provide more information, I'd gladly do it.

I guess the easiest way to do this would be to record a macro where you (1) Filter for values <=8; (2) copy the entire dataset; (3) Paste it to the 0to8 sheet, then repeat it for >8 and empties and you're done.... — John Bustos
Thanks. I tried your suggestions but it won't work for what I need to do with the data after it's been filtered. — BlueSun3k1

Raystafarian Raystafarian · Accepted Answer · 2014-03-20T18:59:17

Something like this should work, change as needed:

Sub test()
Application.ScreenUpdating = False
Dim i As Integer
Dim j As Integer
Dim k As Integer
i = 1
j = 1
k = 1

Dim DB As Worksheet
Dim zeroeight As Worksheet
Dim nineten As Worksheet
Dim blnk As Worksheet

Dim c As Range

For Each c In DB.Range("AJ:AJ")
     If c = "" Then
        If c.Offset(-1) <> "" Then
            c.EntireRow.Cut blnk.Cells(i, 1)
            i = i + 1
        Else: goto label
        End If

     ElseIf c > 8 Then
        c.EntireRow.Cut nineten.Cells(j, 1)
        j = j + 1

     ElseIf c > 1 Then
        c.EntireRow.Cut zeroeight.Cells(k, 1)
        k = k + 1
     End If

Next
Application.ScreenUpdating = True
label:
End Sub

Find column that meets Criteria and Copy Row to another Sheet

1 Answers