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

ZipLipZ

New Member
Joined
Mar 4, 2005
Messages
20
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!
 

Some videos you may like

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

Glaswegian

Well-known Member
Joined
Oct 14, 2003
Messages
1,487
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

New Member
Joined
Mar 4, 2005
Messages
20
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

Well-known Member
Joined
Apr 28, 2004
Messages
76,230
Office Version
  1. 365
Platform
  1. Windows
Perhaps try this adaptation of Iain's code.
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

Well-known Member
Joined
Oct 14, 2003
Messages
1,487

ADVERTISEMENT

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

New Member
Joined
Dec 31, 2004
Messages
8
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

New Member
Joined
Mar 4, 2005
Messages
20

ADVERTISEMENT

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

Well-known Member
Joined
Apr 28, 2004
Messages
76,230
Office Version
  1. 365
Platform
  1. Windows
Which line is causing the error?

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

ZipLipZ

New Member
Joined
Mar 4, 2005
Messages
20
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

Well-known Member
Joined
Apr 28, 2004
Messages
76,230
Office Version
  1. 365
Platform
  1. Windows
Is this the line that is causing the problem?
Code:
LastRow = wsCopy.Range("A65536").End(xlUp)
It's my fault I think, try this instead.
Code:
LastRow = wsCopy.Range("A65536").End(xlUp).Row
 

Watch MrExcel Video

Forum statistics

Threads
1,123,304
Messages
5,600,861
Members
414,408
Latest member
macroSmith

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top