Copy rows to two different spreadsheets depending on criteria

Question

I have a column "B" that is populated with a series of numbers of six digits. I am looking for my code to look up the last digit and, depending on the result (0 to 4 or 5 to 9), copy it into a separate spreadsheet. The I have code picks up the last digit on each row in column B but then doesn't paste it into the right sheet:

For r = 1 To endRow

 ThisValue = Range("B" & r).Value
 LResult = Right(ThisValue, 1)


If LResult = 0 Or 1 Or 2 Or 3 Or 4 Then

        Rows(r).Select
        Selection.Copy

        Sheets("Sheet2").Select
        Rows(pasteRowIndex).Select
        ActiveSheet.Paste

        pasteRowIndex = pasteRowIndex + 1

        Sheets("Sheet1").Select

        Else

        Rows(r).Select
        Selection.Copy

        Sheets("Sheet3").Select
        Rows(pasteRowIndex).Select
        ActiveSheet.Paste

        pasteRowIndex = pasteRowIndex + 1

        Sheets("Sheet1").Select

    End If
Next r

Take a loook at this solutions, which should be must faster: http://stackoverflow.com/a/28992103/78522 — iDevlop, Nov 05 '15 at 16:52
Did you ever declare `endRow`? Also, how do you determine the `pasteRowIndex` the first time? — BruceWayne, Nov 05 '15 at 16:52

score 1 · Answer 1 · edited May 23 '17 at 12:03

When using multiple worksheets, it's very important to make sure you tell Excel what sheets to use and also, avoid using .Select whenever possible.

Please see the below code. I have added some variables for your worksheets. I'm not positive which sheet has your ThisValue so you may need to edit the ws1 as necessary:

Sub test()
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")
endrow = ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row
pasteRowIndex = 1
For r = 1 To endrow

    ThisValue = ws1.Range("B" & r).Value
    LResult = Right(ThisValue, 1)

    If LResult = 0 Or LResult = 1 Or LResult = 2 Or LResult = 3 Or LResult = 4 Then
        ws2.Rows(pasteRowIndex).Value = ws1.Rows(r).Value
        pasteRowIndex = pasteRowIndex + 1
    Else
        ws3.Rows(pasteRowIndex).Value = ws1.Rows(r).Value
        pasteRowIndex = pasteRowIndex + 1
    End If
Next r

End Sub

Also, try and see how I removed your .Select and just worked directly with the cells.

Edit: Where do you define what pasteRowIndex is? It's not in the code you provided, and I assume you have it elsewhere...but you need it here. What is that? I have, for testing purposes, set it to 1 for the first iteration. After that, it just adds one to that number.

Also, I removed the copy/paste, which can get tricky/annoying with multiple sheets (in my opinion), so instead I just set the two rows' values equal to eachother. Can you see how I did that?

Finally, when using and or or to check a variable's value, you must repeat the logic every time. See how I changed your line to include LResult = for each numerical value? Another way you could have done that is If LResult <= 4 Then ...

score 0 · Answer 2 · answered Nov 05 '15 at 16:44

0

I believe all the conditions need to be spelled out, so instead of Or 1 it should be Or LResult = 1. But you might be better off using a Select Case:

Select Case LResult
    Case 0 To 4
        ' ... Code
    Case Else
        ' ... Code
End Select

answered Nov 05 '15 at 16:44

Demetri

869
1
6
12

Copy rows to two different spreadsheets depending on criteria

2 Answers2