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

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.

ravishankar

Well-known Member
Joined
Feb 23, 2006
Messages
3,566
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
 

Gareth 1105

New Member
Joined
Jul 25, 2007
Messages
4
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
 
Joined
Jul 30, 2006
Messages
3,656
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
 

Forum statistics

Threads
1,181,722
Messages
5,931,673
Members
436,798
Latest member
spprtpplcm

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