keeping it really simple

Option Explicit
Sub test()
CopyRows "x"
End Sub

Sub CopyRows(dept As String)
Dim targetIndex As Long
Dim sourceIndex As Long
Dim targetSheet As Worksheet
Dim sourceSheet As Worksheet

Set sourceSheet = Worksheets("sheet1")
Set targetSheet = GetSheet(dept)

Application.ScreenUpdating = False

For sourceIndex = 1 To sourceSheet.Range("A65000").End(xlUp).Row

If sourceSheet.Cells(sourceIndex, 1).Value = dept Then

targetIndex = targetIndex + 1
targetSheet.Rows(targetIndex).Value = _
sourceSheet.Rows(sourceIndex).Value

End If

Next

Application.ScreenUpdating = True

End Sub
Function GetSheet(sheetsname As String) As Worksheet
On Error Resume Next
Set GetSheet = Worksheets(sheetsname)
If Err.Number = 0 Then
GetSheet.Cells.Clear
Else
Set GetSheet = Worksheets.Add
GetSheet.Name = sheetsname
End If
On Error GoTo 0
End Function


this should be easy enough. screen updating speeds things up quite a bit
we simple check each row to see if the cell in A matches teh dept, then we
copy it. we keep a record of which is the nest row to update.

Its probably faster to use 'FIND' so I'll add that routine in my next mail
shortly


"Tim" wrote:

Hi folks,

I need a help on Excel macro. I have a spreadsheet which called sheet1 and
has thousands of records and group by departments. I want to create a macro
which can move the same departments records to the new sheet and rename the
sheet to the department name. Could anyone show me the code? Any help will
be appreciated?

Thanks in advance.

Tim.