cut and paste variabe ranges in one sheet to different sheets in workbook

[philaugust2004]

I have a spreadsheet with data in columns A-K.
Row 1 is always the header but their are varying numbers of row
depending on the original source data (which comes from an externa
database)
Column J contains employee names (each employee name is in a continuou
range but this range is never static). There can be anything from 1-3
names listed in Column J and each name can have any number of rows.
What I want to do is for each name (apart from the first range) to cu
and paste the range into a new worksheet and delete any empt
worksheets.

So if column J had this

Jack
Jack
Bob
Bob
Bob
Tim
Tim
Tim
Tim

I want to leave all the data for Jack in the original sheet and cut an
paste all of Bob to sheet2 and Tim to sheet3 and so on. Row 1 should b
copied to each sheet also so actual data starts in row2 for each sheet
This eaxmple would then have a workbook with 3 sheets. If I had a fourt
name in Column J then it would have 4 sheets
I already worked out a macro to rename sheets based on the value in J
and to insert totals on each sheet but am currently manually cuttin
and pasting.

Thanks for your help
Phi

 

[...Patrick]

you want a sample ?

 

[philaugust2004]

Yes id like a sample VBA script ifd poss.

I have loked around the forum and now know that I have to use Dynami
Ranges. . I found a macro on Ron de Bruins site that does about 80% o
what i need. All i want to do now is to make the macro stop when th
number of varaibles in sheet 1 is reached. I also want to remove th
part that changes the worksheet name as i have this part combine
elsewhere in another macro.
I presume i just delete the part that starts "WSNew.Name = cell.Value
up to "On Error GoTo 0"
i copy the macro below

Sub Copy_With_AdvancedFilter()
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long

Set ws1 = Sheets("Sheet1")
Set rng = ws1.Range("phone")
'Use a Dynamic range name
http://www.contextures.com/xlNames01.html#Dynamic
'This example filter on the first column in the range (change thi
if needed)

With ws1
rng.Columns(1).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
'You see that the last two columns of the worksheet are used t
make a Unique list
'and add the CriteriaRange.(you can't use this macro if you us
this columns)
Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value

For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value

Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number > 0 Then
MsgBox "Change the name of : " & WSNew.Name &
manually"
Err.Clear
End If
On Error GoTo 0

rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
Next
.Columns("IU:IV").Clear
End With
End Su