I'm trying to seperate a workbook into multiple sheets. I'm creating a
routine that will take the unique values from column 3 and create a new
sheet for each value. When I do the filtering I only get a few rows. I've
tried multiple criteria and I don't get any better results.

1. create new temp sheet to store values I want to filter and seperate
2. create new sheet and name it with the filter value
3. create the filter formula
4. execute advancefilter and copy the results.

Column headings are in row 1 and the data starts in row 9. I want to filter
on column C.

I have copied the code with some comments. Any help would be appreciated.


Option Explicit

Sub SeperateConversionType()
Dim tmpSheet As Worksheet
Dim DataSheet As Worksheet
Dim newWkb As Workbook
Dim newWks As Worksheet
Dim myDatabase As Range
Dim listRange As Range
Dim myCell As Range
Dim dummyRange As Range


Const TopLeftCell = "A9"
Const KeyColumn = "C"

'Get first sheet and select data THis is about 2000 rows
Set DataSheet = Worksheets(1)
With DataSheet
Set dummyRange = .UsedRange
Set myDatabase = .Range(TopLeftCell,
..Cells.SpecialCells(xlCellTypeLastCell))
End With

'add blank sheet for processing
Set tmpSheet = Worksheets.Add

'Get unique convertypes, there seems to be a problem when the first two rows
are identical it copies both.
With DataSheet
Intersect(myDatabase, .Columns(KeyColumn)).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=tmpSheet.Range("A1"), _
Unique:=True
End With

'Get list of conversion types, type will be E, M, F, or P. Start at A2
because the list always has the first two rows identical.
With tmpSheet
Set listRange = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
End With

For Each myCell In listRange.Cells
'change the criteria in the Criteria range
Set newWks = Worksheets.Add
newWks.Name = myCell.Value
newWks.Move After:=Sheets(Sheets.Count)
tmpSheet.Range("b2").Value = "=c9" & "=" & myCell.Value

myDatabase.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=tmpSheet.Range("b1:b2"), _
CopyToRange:=newWks.Range("A1"), _
Unique:=False

Next myCell

End Sub