Excel & VBA: Copy rows into a new sheet based on cell value

Question

I'm a total newbie in Excel and VBA. I have a sheet like this:

A        B        C         D
someinfo someinfo someinfo OK
someinfo someinfo someinfo OK
someinfo someinfo someinfo ERROR
someinfo someinfo someinfo ERROR
someinfo someinfo someinfo OK
someinfo someinfo someinfo OK
someinfo someinfo someinfo ERROR
someinfo someinfo someinfo ERROR

Ok I'd like to copy the "OK" lines into a new sheet and the one with "ERROR" into another one.

How can I do that?

Easiest way would be to use filtering and just filter for `OK`, then copy/paste, then filter for `ERROR`, then copy/paste. If you do that while recording a macro, you'll be 90% of the way to having a VBA solution — John Bustos, Jun 12 '13 at 16:34
This had been answered numerous times on this sure, use the search before posting. You may also check my answers, I answered a similar question earlier today. — user2140261, Jun 12 '13 at 16:42
Sorry I search over stackoverflow but I probably didn't find the topic you are refering to. — net.cat, Jun 13 '13 at 08:13

user2140261 · Answer 1 · 2013-06-13T12:20:36.780

4

As stated in earlier comments this is how you would Filter~>Copy~>Paste

Sub FilterAndCopy()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


Dim lngLastRow As Long
Dim OKSheet As Worksheet, ErrorSheet As Worksheet

Set OKSheet = Sheets("Sheet2") ' Set This to the Sheet name you want all Ok's going to
Set ErrorSheet = Sheets("Sheet3") ' Set this to the Sheet name you want all Error's going to

lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row


With Range("A1", "D" & lngLastRow)
    .AutoFilter
    .AutoFilter Field:=4, Criteria1:="OK"
    .Copy OKSheet.Range("A1")
    .AutoFilter Field:=4, Criteria1:="ERROR"
    .Copy ErrorSheet.Range("A1")
    .AutoFilter
End With


Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

edited Jun 13 '13 at 12:20

answered Jun 12 '13 at 17:44

user2140261

7,855
7
32
45

Running this it copies only the first line, probably because OK and Error are the results of a function which analyse every row – net.cat Jun 13 '13 at 08:11
@user1800517 That hsouldn't matter as long as the cells hold the Value Ok or Error. It might be because I used Column A as a reference for finding the last row of your data if you are NOT using Column A or there is a chance that Column A does not have values all the way to the bottom, then you may have to change the line `lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row`, you would change the `"A"` to whatever column contains your last row of data. I have tested this code my self with your exact data. It has worked for me. – user2140261 Jun 13 '13 at 12:17

Al.Sal · Answer 2 · 2013-06-12T17:56:47.240

2

Try something like this...

Set sh = ThisWorkbook.Sheets("Sheet1")
Set sh2 = ThisWorkbook.Sheets("Sheet2")
Set sh3 = ThisWorkbook.Sheets("Sheet3")
lastrow = sh.Cells(Rows.Count, "A").End(xlUp).row
R = 2 
Do While R <= lastrow
     If sh.Range("D" & R) = "OK" Then
         sh.Range("A" & R & ":D" & R).Copy _
         Destination:=sh2.Range("A" & R)
     Else
         sh.Range("A" & R & ":D" & R).Copy _
         Destination:=sh3.Range("A" & R)
     End IF
Loop

You would need to change the rows/columns the data is coming from to suit your needs, but I wrote this based off your example.

EDIT: On second thought, I did some reading about filters and I would go with what others here have posted.

edited Jun 12 '13 at 17:56

answered Jun 12 '13 at 17:35

Al.Sal

984
8
19

This would cause an Endless loop you are not incrementing `R`. So `R` will ALWAYS be less then `lastrow`. I think you ment to use `For R = 2 to lastrow` and replace `Loop with Next R`. Also yours is MUCh slower. I ran both our code over 10,000 Rows 5 times each Mine had an avergage time of 0.615133072755998 while yours had an average time of 16.982829004747300. Thats ALMOST 28 Times slower then mine. – user2140261 Jun 12 '13 at 18:09
I forgot to add R = R + 1. But you're completely right. I am too a newbie in excel but I was working on some code where I solved a problem this way. Filters are the way to go, though and I'll keep that in mind. – Al.Sal Jun 12 '13 at 18:11
It's fine I'm still learning everyday also. I only answered this question because I answered YOUR question earlier today with an almost identical answer, and figured maybe you missed that answer so I repeated it here. – user2140261 Jun 12 '13 at 18:33
I did get mixed up. Thank you (again) for the help! – Al.Sal Jun 12 '13 at 18:34

Excel & VBA: Copy rows into a new sheet based on cell value

2 Answers2

Linked