Take the 2-minute tour ×
Stack Overflow is a question and answer site for professional and enthusiast programmers. It's 100% free, no registration required.

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?

share|improve this question
1  
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. –  user1800517 Jun 13 '13 at 8:13
add comment

2 Answers

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.

share|improve this answer
 
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
add comment

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
share|improve this answer
 
Running this it copies only the first line, probably because OK and Error are the results of a function which analyse every row –  user1800517 Jun 13 '13 at 8: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
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.