This might work ok for you.

I did assume one row of headers.

Option Explicit
Sub testme2()

Application.ScreenUpdating = False

Dim curWks As Worksheet
Dim newWks As Worksheet
Dim rng As Range
Dim myUniqueCells As Range
Dim myCell As Range
Dim myPath As String

myPath = "C:\my documents\excel\test"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

Set curWks = Worksheets("sheet1")

With curWks
.AutoFilterMode = False
Set rng = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))

rng.AdvancedFilter Action:=xlFilterInPlace, Unique:=True

Set myUniqueCells = rng.Offset(1, 0) _
.Resize(rng.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)

.ShowAllData
rng.AutoFilter

For Each myCell In myUniqueCells.Cells
rng.AutoFilter Field:=1, Criteria1:=myCell.Value
Set newWks = Workbooks.Add(1).Worksheets(1)
With rng
.SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Destination:=newWks.Range("a1")
End With
With newWks
On Error Resume Next
.Name = myCell.Value
If Err.Number < 0 Then
MsgBox "Error renaming " & .Name & " (for: " _
& myCell.Value & ")" & vbLf & _
"Please rename and save manually!"
Err.Clear
Else
Application.DisplayAlerts = False
On Error Resume Next
.Parent.SaveAs Filename:=myPath & .Name, _
FileFormat:=xlNormal
If Err.Number < 0 Then
MsgBox "Error saving " & .Name & vbLf _
& "Please save manually"
Err.Clear
Else
.Parent.Close savechanges:=False
End If
End If
On Error GoTo 0
End With
Next myCell
.ShowAllData
End With

With Application
.CutCopyMode = False
.ScreenUpdating = True
End With

End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

thang wrote:

Hello,

I have a list in one worksheet, the column A contains the
manager's name, the same manager is found in many
different lines of the list.
I want to copy lines with the same manager in another
workbook and save it with this manager's name.

How can I do it automatically (probably with VBA).
Please give me help for this matter and many thanks.

T

--

Dave Peterson