Filter a sheet by value in column P

[Ajay]

Morning All
I need to sort an excel sheet with 20000 rows of data into separate
worksheets according to the customer name in column P. I can do this manually
but am looking for an easy quick fix due to time. I have approx 180 different
customers.

Thankks in Advance

Ajay

 

[Joel]

the code below assumes the original worksheet is called Summary and there is
one header row on the sheet. The code will sort the Summary sheet by column
P and then copy each customers data to a new worksheet. The new worksheet
will be named using the customer name. Make sure no sheets already exist
with the customer name.


Sub splitcustomers()

Set SumSht = Sheets("Summary")
With SumSht
Lastrow = .Range("P" & Rows.Count).End(xlUp).Row
Set SortRange = .Rows("2:" & Lastrow)
SortRange.Sort _
key1:=.Range("P2"), _
order1:=xlAscending, _
header:=xlNo

RowCount = 2
StartRow = RowCount
Do While .Range("P" & RowCount) <> ""
'check to see where one customer ends
If .Range("P" & RowCount) <> .Range("P" & (RowCount + 1)) Then
'Create New worksheet at end of workbook
Set newsht = Sheets.Add(after:=Sheets(Sheets.Count))
'rename new worksheet
customer = .Range("P" & RowCount)
newsht.Name = customer

'Copy head row to new sheet
.Rows(1).Copy Destination:=newsht.Rows(1)
'Copy customers to new sheet
Set CopyRange = .Rows(StartRow & ":" & RowCount)
CopyRange.Copy Destination:=newsht.Rows(2)
StartRow = RowCount + 1
End If
RowCount = RowCount + 1

Loop
End With


End Sub

 

[Ajay]

Just the job Many thanks Joel

the code below assumes the original worksheet is called Summary and there is
one header row on the sheet. The code will sort the Summary sheet by column
P and then copy each customers data to a new worksheet. The new worksheet
will be named using the customer name. Make sure no sheets already exist
with the customer name.


Sub splitcustomers()

Set SumSht = Sheets("Summary")
With SumSht
Lastrow = .Range("P" & Rows.Count).End(xlUp).Row
Set SortRange = .Rows("2:" & Lastrow)
SortRange.Sort _
key1:=.Range("P2"), _
order1:=xlAscending, _
header:=xlNo

RowCount = 2
StartRow = RowCount
Do While .Range("P" & RowCount) <> ""
'check to see where one customer ends
If .Range("P" & RowCount) <> .Range("P" & (RowCount + 1)) Then
'Create New worksheet at end of workbook
Set newsht = Sheets.Add(after:=Sheets(Sheets.Count))
'rename new worksheet
customer = .Range("P" & RowCount)
newsht.Name = customer

'Copy head row to new sheet
.Rows(1).Copy Destination:=newsht.Rows(1)
'Copy customers to new sheet
Set CopyRange = .Rows(StartRow & ":" & RowCount)
CopyRange.Copy Destination:=newsht.Rows(2)
StartRow = RowCount + 1
End If
RowCount = RowCount + 1

Loop
End With


End Sub

 

[Suleman Peerzade]

Hi,

Try this
http://www.rondebruin.nl/copy5.htm
--
_______________________
Click "Yes" if it helps
________
Thanks
Suleman Peerzade