copying a row to another worksheet based on a cell criteria

Gareth 1105

New Member
Joined
Jul 25, 2007
Messages
4
hi all

Just started to have a look at vba as I am trying to use excel more efficiently, the problem I have is this, my spreadshet consists of rows like the following

DATE NAME FACULTY REASON LESSONS
8/7 MR JONES ENGLISH ILLNESS 6
8/7 MRS MEL MATHS LOA 5
9/7 MR TOM SCIENCE MEETING 3

I want to copy the rows to other worksheets dependent on column C (faculty), so someone from english would go onto a worksheet for english,a row with maths would go into a worksheet called maths etc.

thank you in advance of any advice

:p
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Hi
Assuming you have all sheets named by faculty , Paste the following codes in the macro window ( Alt F11)

Code:
Sub allocate()
x = Cells(Rows.Count, 3).End(xlUp).Row
For a = 2 To x
b = Cells(a, 3)
rows(a).copy
y = Worksheets(b).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(b).rows(y+1).pastespecial
Next a
MsgBox "Completed"
End Sub
Run the macro
Ravi
 
Upvote 0
the macro seems to take the first instance of maths, but the following rows with maths in them are not recorded, this is the same for every faculty

any suggestions ?

thank you
 
Upvote 0
Gareth 1105,

I have modified ravishankar's code slightly. This should work, and not have the highlighted rows/cells after the macro.

Code:
Option Explicit
Sub allocate()
'
' Original code by ravishankar
'
' Modified 07/25/2007 by Stanley D. Grom, Jr.
'
    Dim x, a, y As Long
    Dim b As String
    Application.ScreenUpdating = False
    x = Cells(Rows.Count, 3).End(xlUp).Row
    For a = 2 To x
        b = Cells(a, 3)
        y = Worksheets(b).Cells(Rows.Count, 1).End(xlUp).Row
        Sheets("Sheet1").Range(Cells(a, "A"), Cells(a, "E")).Copy Destination:=Sheets(b).Cells(y + 1, 1)
    Next a
    Application.ScreenUpdating = True
    MsgBox "Completed"
End Sub

Have a great day,
Stan
 
Upvote 0

Forum statistics

Threads
1,214,585
Messages
6,120,394
Members
448,957
Latest member
Hat4Life

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
Back
Top