copy row to other sheets depending on cell value (multiple values!)

[Armitage2k]

Hi,

I have a worksheet with raw data and now would need to go through every single row to check if column I is holding a specific number, and if yes, copy it to another sheet. totally there are several options where I need to copy to.

Cell value - sheet name
2660 - Blue
2200 - Cafe
2230 - Marcos
2290 - Vbar

So basically, if column I cell content is 2230, then copy the entirerow to sheet marcos. if value is 2290 then copy to vbar, if 2660 copy to blue, etc.
I did find several samples via google where this topic is explained, but the problem is that I have around 5000 rows of data and dont want to loop through the entire data 4 times to check one by one if there is a match...

Any suggestions are welcome!
Thanks,
A2k

[AB33]

Please attach a sample and will write you a faster code.

[Armitage2k]

My current very simple attemp for your reference.

Sub Distributer()
Set r = ActiveWorkbook.Sheets("temp").Range(Range("I65536").End(xlUp), Range("I2"))

'Marcos Chinese Kitchen
For Each C In r
    If C.Value = "2000" Then C.EntireRow.Copy Destination:=Worksheets("Marcos_Data").Range("A65536").End(xlUp).Offset(1, 0)
Next
For Each C In r
    If C.Value = "2030" Then C.EntireRow.Copy Destination:=Worksheets("Marcos_Data").Range("A65536").End(xlUp).Offset(1, 0)
Next
For Each C In r
    If C.Value = "2090" Then C.EntireRow.Copy Destination:=Worksheets("Marcos_Data").Range("A65536").End(xlUp).Offset(1, 0)
Next

end sub

Thanks,
A2k

[AB33]

You can shorten it

Sub Distributer()
Set r = ActiveWorkbook.Sheets("temp").Range(Range("I65536").End(xlUp), Range("I2"))

'Marcos Chinese Kitchen
For Each C In r
    If C.Value = "2000" Then
        C.EntireRow.Copy Worksheets("Marcos_Data").Range("A65536").End(xlUp).Offset(1)

    ElseIf C.Value = "2030" Then
        C.EntireRow.Copy Worksheets("Marcos_Data").Range("A65536").End(xlUp).Offset(1)

    ElseIf C.Value = "2090" Then
        C.EntireRow.Copy Worksheets("Marcos_Data").Range("A65536").End(xlUp).Offset(1)
    
    End If
Next

End Sub

[Armitage2k]

hmm... well, why not, its something

I guess there is absolutely no way for me to have an elegant solution like

If C.Value = "2000" OR "2200" or "2290" then

bummer.
But thanks a lot for the help.
A2k

[AB33]

Of course you can have; I did not notice that you are copying in to the same sheet.

Sub Distributer()
Application.ScreenUpdating = 0
Dim r As Range, c As Range
Set r = ActiveWorkbook.Sheets("temp").Range(Range("I65536").End(xlUp), Range("I2"))

'Marcos Chinese Kitchen
For Each c In r
    If c.Value = "2000" Or c.Value = "2030" Or c.Value = "2090" Then
        c.EntireRow.Copy Worksheets("Marcos_Data").Range("A65536").End(xlUp).Offset(1)
    End If
Next
Application.ScreenUpdating = True
End Sub

[Armitage2k]

Madly in love with you AB33,
thanks a lot
A2k

[congokin]

i have a similar question but this time i need to copy a range instead of specific value
i have a workbook with 2 worksheet "24hrData" and "PitSession". I just need to get the 0900-1430 (pit session) of the "24hrData" worksheet and transfer to "PitSession" worksheet
I could use the code above and write for every time but i need a more efficient way to do it

Sub Distributer()
Application.ScreenUpdating = 0
Dim r As Range, c As Range
Set r = ActiveWorkbook.Sheets("24hrData").Range(Range("B65536").End(xlUp), Range("B2"))
'Marcos Chinese Kitchen
For Each c In r
    If c.Value = "0700" Or c.Value = "0701" Or c.Value = "0702" Or c.Value = "0703" Or c.Value = "0704" Or c.Value = "0705" Then   'I want to copy from 0700...1430 end of pit session
        c.EntireRow.Copy Worksheets("PitSession").Range("A65536").End(xlUp).Offset(1)
    End If
Next
Application.ScreenUpdating = True
End Sub

can someone help me on this?

[AB33]

congokin,
You need to start your own thread. Please read forum rules.