View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Bernie Deitrick Bernie Deitrick is offline
external usenet poster
 
Posts: 5,441
Default Create new worksheet from exisitng data

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