Thanks Ron, the filter column will be A and i want to name the rang
"Customer" just as i have named the range in Supplier as "Database"

--
GazM
-----------------------------------------------------------------------
GazMo's Profile: http://www.excelforum.com/member.php...fo&userid=1461
View this thread: http://www.excelforum.com/showthread.php?threadid=26926

If I understand you correct?

If you have a named range "Customer" in sheet1
for example A1:H1000 this example will do what you want

Copy this in a module

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

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

With ws1
rng.Columns("A").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
'You see that the last two columns of the worksheet are used to make a Unique list
'and add the CriteriaRange.(you can't use this macro if you use 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

If SheetExists(cell.Value) = False Then
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
On Error GoTo 0
Else
Set WSNew = Sheets(cell.Value)
End If

Lr = LastRow(WSNew)

rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A" & Lr + 1), _
Unique:=False
Next
.Columns("IU:IV").Clear
End With
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function

--
Regards Ron de Bruin
http://www.rondebruin.nl


"GazMo" wrote in message ...

Thanks Ron, the filter column will be A and i want to name the range
"Customer" just as i have named the range in Supplier as "Database"!


--
GazMo
------------------------------------------------------------------------
GazMo's Profile: http://www.excelforum.com/member.php...o&userid=14610
View this thread: http://www.excelforum.com/showthread...hreadid=269267