Thank you for the response. I popped this code into my excel and got
an error at this point:

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

Unfortunately I will not have time to play around with it until next
week. I do hope to continue working on it then.

Thank you again.

On Mar 14, 8:00*am, Joel wrote:
The code gets all the sheet names at the beginning. *Then loop through this
list of names. *The way when you add a new sheet the code doesn't look at the
new sheets only the old sheets.

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
Dim sheetnames() As Variant
ReDim sheetnames(Sheets.Count)
Index = 0
For Each sht In ThisWorkbook.Sheets
* *sheetnames(Index) = sht.Name
* *Index = Index + 1
Next sht

For Each sht In sheetnames

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

* *Set myArea = sht.ActiveCell.CurrentRegion. _
* * * Columns(KeyCol).Offset(0, 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

Next sht

End Sub



"Dow" wrote:
I posted this previously but I have discovered a few more things about
it and still need some help.

I need help making this macro loop through more than one worksheet.
And I need to make sure that the information appends correctly. *Or I
need a different Macro that will do that. *I have looked at
http://www.contextures.com/excelfiles.htmland unfortunately the
macros there did not quite do what I need.

I have anywhere from one to 16 different worksheets with no duplicate
information. *It is all in the same format, the worksheet names will
differ from month to month.

What I need to do is create new worksheets based on the information
from a column. *Column K could have anywhere from 1 to 6 different
values A, B, C, D, E, or F. *I need a seperate worksheet with all the
rows containing the A's, all the B's, etc.

This macro works great on one worksheet. *I have tried a few things to
make it work on more than one but I have had no luck and I know there
are a lot of people here with much more experiance than I have. *Thank
you for any help you can provide.

From a post by Bernie Deitrick:
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(0,
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- Hide quoted text -

- Show quoted text -