Macro for multi-user reporting

[ante]

I would be greatfull if someone could help me with this problem.
I have master sheet wich consist of about 600 rows. Row 3 has column names,
and columns have always same format and they consist data about workers (data
are in columns A-M). column C has the name of person in charge for the worker
shown in each row.
End result for macro would be making of separate workbooks for all persons
in charge stated in master sheet and data records for only persons for who
he/she is in charge.
Number or rows(records for each worker) will be various depending on
employment (curently around 600),also number of person in charge could be
various (curently about 30)
New workbook can be named as choosen person in charge
Newly made workbooks would just have copied formats and not formula.

Thanks for any sugestions in advance.

P.S. Also if there is any way of making automated mailing of data I could
add mail adress in column N. That would probably mean dream come true.

bye

 

[Joel]

Try this code. Change FOLDER to the location where you want the new
workbooks to be stored. Create folder if necessary. the code will sort the
original data by supervisors. the code expects the macro to be in the same
workbook as the source data and the sheet with the employess to be the active
worksheet.

Sub MakeSupervisorBooks()

Folder = "c:\temp\"

'sort worksheet by Managers
LastRow = Range("C" & Rows.Count).End(xlUp).Row

With ThisWorkbook.ActiveSheet
.Rows("4:" & LastRow).Sort _
Key1:=.Range("C1"), _
Order1:=xlAscending, _
Header:=xlNo
RowCount = 4
FirstRow = RowCount 'firstrow is the first row for each supervisor
Do While .Range("C" & RowCount) <> "" 'loop until all the rows are
processed
'test when last row for supervisor is found
If .Range("C" & RowCount) <> .Range("C" & (RowCount + 1)) Then
Supervisor = .Range("C" & RowCount)
'Open new Workbook
Set NewBk = Workbooks.Add
Set NewSht = NewBk.ActiveSheet
NewSht.Name = Supervisor
'copy header row 3 to new workbook
.Rows(3).Copy Destination:=NewSht.Rows(1)
'copy employee rows to new workbook
.Rows(FirstRow & ":" & RowCount).Copy
NewSht.Rows(2).PasteSpecial Paste:=xlPasteValues
'save new workbook
NewBk.SaveAs Filename:=Folder & Supervisor & ".xls"
NewBk.Close
'Set firstrow to first row of next supervisor
FirstRow = RowCount + 1
End If

RowCount = RowCount + 1
Loop
End With
End Sub

 

[ante]

I did one adjustment but this code just did great job for me.

Thanks mate!!!