Jay,

The code was written for and tested on data that had strings for keys. Using
numbers requires that you change the line

myName = Worksheets(myCell.Value).Name

to

myName = Worksheets(CStr(myCell.Value)).Name

HTH,
Bernie
MS Excel MVP


"JayL" wrote in message
...
Bernie - Thanks! Works great on the first location code but as soon as it
hits the second location code I get and error "1004" cannot rename sheet
to
same name as another. I think it is seeing row 3 as another sheet. ???
here is a snipet of col A and B
Ideally I would have one sheet of all the '101's and one sheet of all the
'111's ...etc
101 8081010766
101 8081010766
101 8081010766
101 8081010766
101 8081010766
111 1111010766
111 1111010766
111 1111010766
111 1111010766
111 1111010766
111 1111010766
111 1111010766
111 1111010766

"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Jay,

Yes.

Copy the macro below and put it into a codemodule of either your
personal.xls or of the workbook with the database.

Select a single cell in your database and run the macro. Since the key
ID
values are in column A, and column A must be the first column of the
database,
enter a 1 when asked "What column # within database to use as key?"

The files will be saved to whatever folder is currently the default
folder,
though that is easy to modify.

HTH,
Bernie
MS Excel MVP

Sub ExportDatabaseToSeparateFiles()
'Export is based on the value in the desired column
Dim myCell As Range
Dim mySht As Worksheet
Dim myName As String
Dim myArea As Range
Dim myShtName As String
Dim KeyCol As Integer

myShtName = ActiveSheet.Name
KeyCol = InputBox("What column # within database to use as key?")

Set myArea = ActiveCell.CurrentRegion.Columns(KeyCol).Offset(1, 0).Cells

Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)

For Each myCell In myArea
On Error GoTo NoSheet
myName = Worksheets(myCell.Value).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(befo=Worksheets(1))
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=KeyCol, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell

'Optional section to export the sheets to separate files
'For Each mySht In ActiveWorkbook.Worksheets
'If mySht.Name = myShtName Then
'Exit Sub
'Else
'mySht.Move
'ActiveWorkbook.SaveAs "Workbook " & ActiveSheet.Name & ".xls"
'ActiveWorkbook.Close
'End If
'Next mySht

End Sub


"JayL" wrote in message
...
All -
I receive a monthly text file I import to Excel.
Column A represents a specific location by code - usually 3 digits with
numerous entries (rows) for each location code. I usually sort by Col A
and cut and paste all the same Col A rows into a new worksheet, thus
creating a new worksheet for each location code. Each worksheet would
ideally be named the location code.

There is potentially 20 or 30 worksheets - which is time consuming to
create manually.
Is there a way to automate this?

TIA
-Jay