Using a cell reference to select a worksheet within a macro
 

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

Using a cell reference to select a worksheet within a macro
 

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

Using a cell reference to select a worksheet within a macro
 

Unfortunately that is not working. Below is the current basic macro which
needs amending.

Again, AC8 is the location of the team as detailed in the previous post. I
need to be able for this to happen automatically every time a new line of
data is entered.

Range("AA2:AE2").Select
Selection.Copy
Sheets("Office Overview").Select - this is what i want to change so
"Office Overview" is Team 1,2,3 or 4 depending on the value of AC8
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Selection.Font.ColorIndex = 0
Selection.Interior.ColorIndex = 0
Sheets("Entry").Select
Range("AA2:AE2").Select
Range("AE2").Activate
Selection.ClearContents
Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.SaveCopyAs ("Objectives 2005 6 backup.xls")
UserForm1.Show

Regards

Richard

"Bernie Deitrick" wrote:

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