I'm not quite sure wot u mean, this is the code the Supplier tab ... ca
u elaborate from this ? I've got the Supplier macro running from
button and want another button in the customer tab ...

Sub Split_Supplier_Codes()
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("Supplier")
Set rng = Range("Database")

'extract a list of Code Nos
ws1.Columns("A:A").Copy _
Destination:=Range("Z1")
ws1.Columns("Z:Z").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("X1"), Unique:=True
r = Cells(Rows.Count, "X").End(xlUp).Row

'set up Criteria Area
Range("Z1").Value = Range("A1").Value

For Each c In Range("X2:X" & r)
'add the code no to the criteria area
ws1.Range("Z2").Value = c.Value
'add new sheet (if required)
'and run advanced filter
If WksExists(c.Value) Then
Sheets(c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Supplier").Range("Z1:Z2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
Set WSNew = Sheets.Add
WSNew.Move After:=Worksheets(Worksheets.Count)
WSNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Supplier").Range("Z1:Z2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=True
End If
Next
ws1.Select
ws1.Columns("Y:Z").Delete
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function

Cheers :confused

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