MACRO - Copy rows from a sheet based on value in B

[ZipLipZ]

Hey all, i appreciate all the help. here is my problem.

I need macro that will go through a sheet and copy entire rows over to there proper worksheet based on the value in the B colum. For example if in B4 the text is "RES" then i need it to copy the row to the next available row in the RES sheet. But if the text is "BOB" then i need it to be sent to the BOB sheet ont he next available row.

Any help would be great.. thankyou!

 

[Glaswegian]

Welcome to the Board!

This should give you a start

Sub CopyTest()
Dim myRng As Range
Dim c As Range
Dim thisCol

Set myRng = Sheets("Sheet1").Range("B1", Range("B65536").End(xlUp))
For Each c In myRng
Select Case c.Value
Case "RES": c.EntireRow.Copy Destination:=Sheets("RES").Range("A65536").End(xlUp).Offset(1, 0)
Case "BOB": c.EntireRow.Copy Destination:=Sheets("BOB").Range("A65536").End(xlUp).Offset(1, 0)
Case Else
End Select
Next
End Sub
Sub OrderSheets()

Change the source sheet name to suit. Make sure that the destination sheet names are correct (upper or lower case). You can add in any additional Cases and sheet names as required.

HTH

Regards

 

[ZipLipZ]

Thank you very much, this helps alot. One question, I have over 50 different sheets like "RES" and what not. Is there a way for it to juse send it to the sheet that is listed in the b column?

 

[Norie]

Perhaps try this adaptation of Iain's code.

Sub CopyTest()
Dim myRng As Range
Dim c As Range
Dim LastRow As Long
Dim wsCopy As Worksheet

    Set myRng = Worksheets("Sheet1").Range("B1", Range("B65536").End(xlUp))
    
    For Each c In myRng
            
        Set wsCopy = Worksheets(c.Value)
        LastRow = wsCopy.Range("A65536").End(xlUp)
        c.EntireRow.Copy wsCopy.Range("A" & LastRow)
    
    Next c
    
End Sub

 

[Glaswegian]

Sure, try this

Sub CopyTest()
Dim myRng As Range
Dim c As Range

Set myRng = Sheets("Sheet1").Range("B1", Range("B65536").End(xlUp))
For Each c In myRng
Select Case c.Value
Case "RES": c.EntireRow.Copy Destination:=Sheets(c.Value).Range("A65536").End(xlUp).Offset(1, 0)
Case "BOB": c.EntireRow.Copy Destination:=Sheets(c.Value).Range("A65536").End(xlUp).Offset(1, 0)
Case Else
End Select
Next
End Sub

I deleted this line
Dim thisCol
not quite sure where it appeared from - sorry!

HTH

Regards

 

[Justin10]

Copy rows bsed upon value in column B

Glaswegian

If all that is different between the copy rows on your first and second example is the target sheet hardcoded then why is a seperate line required for each different value in column B. I tried taking out the case statement but it did not work.

Not essentail that this explained, just interested.

Thanks

 

[ZipLipZ]

I get "subscript out of range" when i try this.. Im very new to VB, I really do appreciate everyones help on this.

Sub CopyTest()
Dim myRng As Range
Dim c As Range
Dim LastRow As Long
Dim wsCopy As Worksheet

Set myRng = Worksheets("Sheet1").Range("B4", Range("B65536").End(xlUp))

For Each c In myRng

Set wsCopy = Worksheets(c.Value)
LastRow = wsCopy.Range("A65536").End(xlUp)
c.EntireRow.Copy wsCopy.Range("A" & LastRow)

Next c

End Sub

 

[Norie]

Which line is causing the error?

Are you sure that you have sheets named after the data in column B?

 

[ZipLipZ]

my apologies, im actually getting a "type mismatch" error. But if i go through it line by line it dosn't come up with the error, only when i try to run it.

here is the code exactly as i have it

Sub CopyTest2()
Dim myRng As Range
Dim c As Range
Dim LastRow As Long
Dim wsCopy As Worksheet

Set myRng = Worksheets("Master").Range("B4", Range("B65536").End(xlUp))

For Each c In myRng

Set wsCopy = Worksheets(c.Value)
LastRow = wsCopy.Range("A65536").End(xlUp)
c.EntireRow.Copy wsCopy.Range("A" & LastRow)

Next c

End Sub

 

[Norie]

Is this the line that is causing the problem?

LastRow = wsCopy.Range("A65536").End(xlUp)

It's my fault I think, try this instead.

LastRow = wsCopy.Range("A65536").End(xlUp).Row