I am going to have multiple values in column B (they will not be the same
every time) that look like the following

A B C....
Apple 328 ...
Orange 427 ...
Pear 328 ...
Grape 519 ...
Banana 427 ...

I will need the unique values (and the entire row) to create a new sheet
(i.e. Apple 328 and Pear 328 should create a new sheet named "328")

As I said, the numbers that create the groups in Column B will be different
every time.

K.I.S.S.,

Try the macro below, first selecting all your data and answering 2 when prompted.

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
'These lines copy everything - including extra header rows
' and any SUBTOTAL formulas separated by blank row
'Uncomment them to use them
' myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
' mySht.Range("A1").PasteSpecial xlPasteValues


'These are the default - only copy the database values
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell

End Sub

"Keep It Simple Stupid" wrote in message
...
I am going to have multiple values in column B (they will not be the same
every time) that look like the following

A B C....
Apple 328 ...
Orange 427 ...
Pear 328 ...
Grape 519 ...
Banana 427 ...

I will need the unique values (and the entire row) to create a new sheet
(i.e. Apple 328 and Pear 328 should create a new sheet named "328")

As I said, the numbers that create the groups in Column B will be different
every time.

An error message tells me that "Cannot rename a sheet to the same name as
another sheet, a referenced object library or a workbook reference by Visual
Basic"
Is it trying to create a new sheet for every row entry or did I forget to
change something?


"Bernie Deitrick" wrote:

K.I.S.S.,

Try the macro below, first selecting all your data and answering 2 when prompted.

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
'These lines copy everything - including extra header rows
' and any SUBTOTAL formulas separated by blank row
'Uncomment them to use them
' myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
' mySht.Range("A1").PasteSpecial xlPasteValues


'These are the default - only copy the database values
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell

End Sub

"Keep It Simple Stupid" wrote in message
...
I am going to have multiple values in column B (they will not be the same
every time) that look like the following

A B C....
Apple 328 ...
Orange 427 ...
Pear 328 ...
Grape 519 ...
Banana 427 ...

I will need the unique values (and the entire row) to create a new sheet
(i.e. Apple 328 and Pear 328 should create a new sheet named "328")

As I said, the numbers that create the groups in Column B will be different
every time.

It might be the numbering.

Try changing:

myName = Worksheets(myCell.Value).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(Befo=Worksheets(1))
mySht.Name = myCell.Value

to

myName = Worksheets(Format(myCell.Value,"0")).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(Befo=Worksheets(1))
mySht.Name = myName

If that doesn't work, would adding a prefix to the number cause you problems?

If not, change the code to

myName = Worksheets("Sht " & Format(myCell.Value,"0")).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(Befo=Worksheets(1))
mySht.Name = myName


HTH,
Bernie
MS Excel MVP


"Keep It Simple Stupid" wrote in message
...
An error message tells me that "Cannot rename a sheet to the same name as
another sheet, a referenced object library or a workbook reference by Visual
Basic"
Is it trying to create a new sheet for every row entry or did I forget to
change something?


"Bernie Deitrick" wrote:

K.I.S.S.,

Try the macro below, first selecting all your data and answering 2 when prompted.

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
'These lines copy everything - including extra header rows
' and any SUBTOTAL formulas separated by blank row
'Uncomment them to use them
' myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
' mySht.Range("A1").PasteSpecial xlPasteValues


'These are the default - only copy the database values
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell

End Sub

"Keep It Simple Stupid" wrote in message
...
I am going to have multiple values in column B (they will not be the same
every time) that look like the following

A B C....
Apple 328 ...
Orange 427 ...
Pear 328 ...
Grape 519 ...
Banana 427 ...

I will need the unique values (and the entire row) to create a new sheet
(i.e. Apple 328 and Pear 328 should create a new sheet named "328")

As I said, the numbers that create the groups in Column B will be different
every time.

I still can't get it to rename the new sheet as the value in Column B. I
don't know how to fix this. I do really need the "group value" as the sheet
name (whether or not it has a prefix). It always goofs when it gets to:

Set mySht = Worksheets.Add(Befo=Worksheets(1))
mySht.Name = myName

(And I have tried replacing myName with myCell.Value. It seems to work
when I put a specific name to the sheet like "Sheet 1", but as you can
imagine, it will not work when it gets around to creating the next sheet
because there is already a sheet named "Sheet 1")

Any ideas?

"Bernie Deitrick" wrote:

It might be the numbering.

Try changing:

myName = Worksheets(myCell.Value).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(Befo=Worksheets(1))
mySht.Name = myCell.Value

to

myName = Worksheets(Format(myCell.Value,"0")).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(Befo=Worksheets(1))
mySht.Name = myName

If that doesn't work, would adding a prefix to the number cause you problems?

If not, change the code to

myName = Worksheets("Sht " & Format(myCell.Value,"0")).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(Befo=Worksheets(1))
mySht.Name = myName


HTH,
Bernie
MS Excel MVP


"Keep It Simple Stupid" wrote in message
...
An error message tells me that "Cannot rename a sheet to the same name as
another sheet, a referenced object library or a workbook reference by Visual
Basic"
Is it trying to create a new sheet for every row entry or did I forget to
change something?


"Bernie Deitrick" wrote:

K.I.S.S.,

Try the macro below, first selecting all your data and answering 2 when prompted.

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
'These lines copy everything - including extra header rows
' and any SUBTOTAL formulas separated by blank row
'Uncomment them to use them
' myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
' mySht.Range("A1").PasteSpecial xlPasteValues


'These are the default - only copy the database values
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell

End Sub

"Keep It Simple Stupid" wrote in message
...
I am going to have multiple values in column B (they will not be the same
every time) that look like the following

A B C....
Apple 328 ...
Orange 427 ...
Pear 328 ...
Grape 519 ...
Banana 427 ...

I will need the unique values (and the entire row) to create a new sheet
(i.e. Apple 328 and Pear 328 should create a new sheet named "328")

As I said, the numbers that create the groups in Column B will be different
every time.

How many sheets are you starting with?
Do you already have a sheet with the name of the 'group value' prior to running the macro?
What kinds of strings do you have in the 'group value' column? Can you manually rename a sheet with
those values, or do they have invalid characters?

HTH,
Bernie
MS Excel MVP


"Keep It Simple Stupid" wrote in message
...
I still can't get it to rename the new sheet as the value in Column B. I
don't know how to fix this. I do really need the "group value" as the sheet
name (whether or not it has a prefix). It always goofs when it gets to:

Set mySht = Worksheets.Add(Befo=Worksheets(1))
mySht.Name = myName

(And I have tried replacing myName with myCell.Value. It seems to work
when I put a specific name to the sheet like "Sheet 1", but as you can
imagine, it will not work when it gets around to creating the next sheet
because there is already a sheet named "Sheet 1")

Any ideas?

"Bernie Deitrick" wrote:

It might be the numbering.

Try changing:

myName = Worksheets(myCell.Value).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(Befo=Worksheets(1))
mySht.Name = myCell.Value

to

myName = Worksheets(Format(myCell.Value,"0")).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(Befo=Worksheets(1))
mySht.Name = myName

If that doesn't work, would adding a prefix to the number cause you problems?

If not, change the code to

myName = Worksheets("Sht " & Format(myCell.Value,"0")).Name
GoTo SheetExists:
NoSheet:
Set mySht = Worksheets.Add(Befo=Worksheets(1))
mySht.Name = myName


HTH,
Bernie
MS Excel MVP


"Keep It Simple Stupid" wrote in message
...
An error message tells me that "Cannot rename a sheet to the same name as
another sheet, a referenced object library or a workbook reference by Visual
Basic"
Is it trying to create a new sheet for every row entry or did I forget to
change something?


"Bernie Deitrick" wrote:

K.I.S.S.,

Try the macro below, first selecting all your data and answering 2 when prompted.

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
'These lines copy everything - including extra header rows
' and any SUBTOTAL formulas separated by blank row
'Uncomment them to use them
' myCell.Parent.Cells.SpecialCells(xlCellTypeVisible ).Copy
' mySht.Range("A1").PasteSpecial xlPasteValues


'These are the default - only copy the database values
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell

End Sub

"Keep It Simple Stupid" wrote in message
...
I am going to have multiple values in column B (they will not be the same
every time) that look like the following

A B C....
Apple 328 ...
Orange 427 ...
Pear 328 ...
Grape 519 ...
Banana 427 ...

I will need the unique values (and the entire row) to create a new sheet
(i.e. Apple 328 and Pear 328 should create a new sheet named "328")

As I said, the numbers that create the groups in Column B will be different
every time.