Thanks Ron! Is there a way to only create sheets and copy data for
specific values in column A? The number of unique values that I have
is about 300...I dont want to create 300 sheets! I'm really only
interested in copying out about 20 of the customers. I have the
customer numbers listed in a sheet called "control", range a1:a20. It
is also a named range called "customer". Thanks again for your help!!


On Mar 21, 10:12*am, "Ron de Bruin" wrote:
Try this one Stevehttp://www.rondebruin.nl/copy5.htm#sheet

--

Regards Ron de Bruinhttp://www.rondebruin.nl/tips.htm



"Steve" wrote in ...
Hello everyone. *I have a data sheet that 14,000 rows long. *In column
A is the customer number. *Then I have a "control" sheet, where I have
a list of customer numbers to pull (copy) from the data sheet
(A3:A20). Can VBA scan the data sheet, create a new sheet for all
entries in Control("A3:A20"), and copy in the entire row for every
instance found in the data sheet for each customer identified in
Control("A3:A20")?

I have some code below that looks at the data sheet, and based on the
value in column A creates a sheet for each unique instance and copies
the data in. *Can this be modified to incorporate the list of values
in the Control sheet? *Basically, The data sheet has over 300
customers in column A. *I dont want to create 300 sheets! *Only about
20, that will be in the list in Control("A1:A20"). *Thanks!!

Sub ParseData()

Application.ScreenUpdating = False
With Sheets("Data")
lr = .Cells(Rows.Count, "a").End(xlUp).Row
*.Range("A1:A" & lr).AdvancedFilter Action:=xlFilterInPlace,
Unique:=True
For Each c In .Range("a2:a" & lr).SpecialCells(xlVisible)
On Error Resume Next
If Worksheets(c.Value) Is Nothing Then
*Worksheets.Add(After:=Worksheets(Worksheets.Count )).Name = c
End If
*.ShowAllData
*.Range("a1:a" & lr).AutoFilter field:=1, Criteria1:=c
dlr = Sheets(c.Value).Cells(Rows.Count, "a").End(xlUp).Row + 1
*.Range("a2:a" & lr).Copy Sheets(c.Value).Range("a" & dlr)
Next c
*.ShowAllData
*.Range("a1:a" & lr).AutoFilter
End With
Application.ScreenUpdating = True
Sheets("Data").Select

End Sub- Hide quoted text -

- Show quoted text -