Richard,
Run the macro below.
HTH,
Bernie
MS Excel MVP
Sub ExportDatabaseToSeparateSheets()
'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
End Sub
"Richard L" <Richard
wrote in message
...
I hope this makes sense!!
I have a spreadsheet for data collection. This has 4 teams (1,2,3 and 4)
which currently gets merged onto 1 huge spreadsheet. I want to be able to
run a macro which splits the data onto 4 separate sheets.
Team 1
Team 2
Team 3
Team 4
I have tried using Sheets(AC8).Select - did not work. AC8 being the cell
referred to from the drop down box where the team number is selected.
Any ideas?
Regards
Richard