I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and 1
apple tap
the second part would copy and past the rows that has the fruit in side the
specific tab.

i thanks in advance for the help

Paulo,

If you have a table with headers in the first row, try the macro below.

HTH,
Bernie
MS Excel MVP

Sub ExportSheetsFromDatabase()
'Based on the value in the first column
Dim myCell As Range
Dim mySht As Worksheet
Dim myName As String
Dim myArea As Range

Set myArea = ActiveCell.CurrentRegion.Columns(1).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
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=1, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell
End Sub


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and 1
apple tap
the second part would copy and past the rows that has the fruit in side the
specific tab.

i thanks in advance for the help

Thank you very much for your help Bernie,

I am begginer @ VBA so i am walking 1 step afthe the other...

I tried your code, but i am getting erro in this line.

Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)



"Bernie Deitrick" wrote:

Paulo,

If you have a table with headers in the first row, try the macro below.

HTH,
Bernie
MS Excel MVP

Sub ExportSheetsFromDatabase()
'Based on the value in the first column
Dim myCell As Range
Dim mySht As Worksheet
Dim myName As String
Dim myArea As Range

Set myArea = ActiveCell.CurrentRegion.Columns(1).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
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=1, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell
End Sub


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and 1
apple tap
the second part would copy and past the rows that has the fruit in side the
specific tab.

i thanks in advance for the help

Assuming the sheet these items are on is named "Sheet1" and that the first
fruit is on Row 1, give this macro a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets("Sheet1").Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and 1
apple tap
the second part would copy and past the rows that has the fruit in side
the
specific tab.

i thanks in advance for the help

Rick , thank you so much for helping out.
I am learning alot from your way of thinking on your code.

I can see some how (since i dont know much about coding) that your code is
able to tell if the fruit already has a tab or not. thats grate for me ;).

unfortunately i am getting debug @ this line.

With Worksheets(.Cells(x, "A").Value)

the first tab "banana"got created and it placed the first banana and the
number 10 on the tab






"Rick Rothstein (MVP - VB)" wrote:

Assuming the sheet these items are on is named "Sheet1" and that the first
fruit is on Row 1, give this macro a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets("Sheet1").Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and 1
apple tap
the second part would copy and past the rows that has the fruit in side
the
specific tab.

i thanks in advance for the help

I think the problem **may** be because your data doesn't start on Row 1.
Here is some revised code which allows you to set the data sheet's name and
the starting row for your data on that sheet via the Const (constant)
statements. Change them to match your conditions and see if that solves your
problem.

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick



"Paulo" wrote in message
...
Rick , thank you so much for helping out.
I am learning alot from your way of thinking on your code.

I can see some how (since i dont know much about coding) that your code is
able to tell if the fruit already has a tab or not. thats grate for me ;).

unfortunately i am getting debug @ this line.

With Worksheets(.Cells(x, "A").Value)

the first tab "banana"got created and it placed the first banana and the
number 10 on the tab






"Rick Rothstein (MVP - VB)" wrote:

Assuming the sheet these items are on is named "Sheet1" and that the
first
fruit is on Row 1, give this macro a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets("Sheet1").Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and
1
apple tap
the second part would copy and past the rows that has the fruit in side
the
specific tab.

i thanks in advance for the help

Paulo,

You need to select a single cell within your contiguous database (no blank rows or columns) prior to
running the code.

HTH,
Bernie
MS Excel MVP


"Paulo" wrote in message
...
Thank you very much for your help Bernie,

I am begginer @ VBA so i am walking 1 step afthe the other...

I tried your code, but i am getting erro in this line.

Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)



"Bernie Deitrick" wrote:

Paulo,

If you have a table with headers in the first row, try the macro below.

HTH,
Bernie
MS Excel MVP

Sub ExportSheetsFromDatabase()
'Based on the value in the first column
Dim myCell As Range
Dim mySht As Worksheet
Dim myName As String
Dim myArea As Range

Set myArea = ActiveCell.CurrentRegion.Columns(1).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
mySht.Name = myCell.Value
With myCell.CurrentRegion
.AutoFilter Field:=1, Criteria1:=myCell.Value
.SpecialCells(xlCellTypeVisible).Copy _
mySht.Range("A1")
mySht.Cells.EntireColumn.AutoFit
.AutoFilter
End With
Resume
SheetExists:
Next myCell
End Sub


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and 1
apple tap
the second part would copy and past the rows that has the fruit in side the
specific tab.

i thanks in advance for the help

TANKS AGAIN FOR HELPPING OUT.. RICK

my "Sheet1" is called Sheet1
I only have Sheet1 tab, i deleted the others.
and the matrix goes exacly like this.

x, A , B
1,grape, 7
2,grape, 5
3,apple, 6
4,apple, 4
5,melon, 5
6,pineapple, 7
7,grape, 15

whith this new code
the result was:
it added the tab grape, its matrix have only row 1: colum A: grape colum B: 5
it added tab apple, its matrix have 2 rows, row 1: apple 6 and row 2: apple 4

and I got debug on the same line.

With Worksheets(.Cells(x, "A").Value)



"Rick Rothstein (MVP - VB)" wrote:

I think the problem **may** be because your data doesn't start on Row 1.
Here is some revised code which allows you to set the data sheet's name and
the starting row for your data on that sheet via the Const (constant)
statements. Change them to match your conditions and see if that solves your
problem.

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick



"Paulo" wrote in message
...
Rick , thank you so much for helping out.
I am learning alot from your way of thinking on your code.

I can see some how (since i dont know much about coding) that your code is
able to tell if the fruit already has a tab or not. thats grate for me ;).

unfortunately i am getting debug @ this line.

With Worksheets(.Cells(x, "A").Value)

the first tab "banana"got created and it placed the first banana and the
number 10 on the tab






"Rick Rothstein (MVP - VB)" wrote:

Assuming the sheet these items are on is named "Sheet1" and that the
first
fruit is on Row 1, give this macro a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets("Sheet1").Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab and
1
apple tap
the second part would copy and past the rows that has the fruit in side
the
specific tab.

i thanks in advance for the help

thanks again Bernie.

for now I am runing on the simpliest DB i could make. it is just as I
described, I have no blank row, or headers or any thing. just those 7 rows
with couple fruits randomly distributed . and i repet some fruits. thats it.
A , B
1,grape 7
2,grape 5
3,apple 6
4,apple 4
5,melon 5
6,pineapple 7
7,grape 15

just like that



"Bernie Deitrick" wrote:

Paulo,

You need to select a single cell within your contiguous database (no blank rows or columns) prior to
running the code.

HTH,
Bernie
MS Excel MVP


"Paulo" wrote in message
...
Thank you very much for your help Bernie,

I am begginer @ VBA so i am walking 1 step afthe the other...

I tried your code, but i am getting erro in this line.

Set myArea = myArea.Resize(myArea.Rows.Count - 1, 1)



"Bernie Deitrick" wrote:

Paulo,

If you have a table with headers in the first row, try the macro below.

HTH,
Bernie
MS Excel MVP

I was able to duplicate your problem. It seems I forgot to reset the FoundIt
variable to False at the start of each loop. Because I did not do that, when
it got to "melon", which did not have its own worksheet, the FoundIt
variable was still True from the previous loop that added "apple" so when it
went to copy to the "melon" sheet it thought was there, the error was
generated because that sheet did not really exist. Try this code and see if
it works now...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
FoundIt = False
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
TANKS AGAIN FOR HELPPING OUT.. RICK

my "Sheet1" is called Sheet1
I only have Sheet1 tab, i deleted the others.
and the matrix goes exacly like this.

x, A , B
1,grape, 7
2,grape, 5
3,apple, 6
4,apple, 4
5,melon, 5
6,pineapple, 7
7,grape, 15

whith this new code
the result was:
it added the tab grape, its matrix have only row 1: colum A: grape colum
B: 5
it added tab apple, its matrix have 2 rows, row 1: apple 6 and row 2:
apple 4

and I got debug on the same line.

With Worksheets(.Cells(x, "A").Value)



"Rick Rothstein (MVP - VB)" wrote:

I think the problem **may** be because your data doesn't start on Row 1.
Here is some revised code which allows you to set the data sheet's name
and
the starting row for your data on that sheet via the Const (constant)
statements. Change them to match your conditions and see if that solves
your
problem.

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick



"Paulo" wrote in message
...
Rick , thank you so much for helping out.
I am learning alot from your way of thinking on your code.

I can see some how (since i dont know much about coding) that your code
is
able to tell if the fruit already has a tab or not. thats grate for me
;).

unfortunately i am getting debug @ this line.

With Worksheets(.Cells(x, "A").Value)

the first tab "banana"got created and it placed the first banana and
the
number 10 on the tab






"Rick Rothstein (MVP - VB)" wrote:

Assuming the sheet these items are on is named "Sheet1" and that the
first
fruit is on Row 1, give this macro a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets("Sheet1").Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the
macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab
and
1
apple tap
the second part would copy and past the rows that has the fruit in
side
the
specific tab.

i thanks in advance for the help

Rick, You are the man...
It almos worked. i didnt understand very deeply what you just explaned. I am
gonna go trow a little more deeply I am ver new @ this.

this time it worked greate. but it diddnt add the last fruit: Grape to the
grape tab.

the way I think the code is working, it did not go trow the entire colum to
check if there was any other entry of the same fruit to copy and paste into
the tabs.

but i am very gratefull for your help I am learning alot from it.

Paulo
"Rick Rothstein (MVP - VB)" wrote:

I was able to duplicate your problem. It seems I forgot to reset the FoundIt
variable to False at the start of each loop. Because I did not do that, when
it got to "melon", which did not have its own worksheet, the FoundIt
variable was still True from the previous loop that added "apple" so when it
went to copy to the "melon" sheet it thought was there, the error was
generated because that sheet did not really exist. Try this code and see if
it works now...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
FoundIt = False
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
TANKS AGAIN FOR HELPPING OUT.. RICK

my "Sheet1" is called Sheet1
I only have Sheet1 tab, i deleted the others.
and the matrix goes exacly like this.

x, A , B
1,grape, 7
2,grape, 5
3,apple, 6
4,apple, 4
5,melon, 5
6,pineapple, 7
7,grape, 15

whith this new code
the result was:
it added the tab grape, its matrix have only row 1: colum A: grape colum
B: 5
it added tab apple, its matrix have 2 rows, row 1: apple 6 and row 2:
apple 4

and I got debug on the same line.

With Worksheets(.Cells(x, "A").Value)



"Rick Rothstein (MVP - VB)" wrote:

I think the problem **may** be because your data doesn't start on Row 1.
Here is some revised code which allows you to set the data sheet's name
and
the starting row for your data on that sheet via the Const (constant)
statements. Change them to match your conditions and see if that solves
your
problem.

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick



"Paulo" wrote in message
...
Rick , thank you so much for helping out.
I am learning alot from your way of thinking on your code.

I can see some how (since i dont know much about coding) that your code
is
able to tell if the fruit already has a tab or not. thats grate for me
;).

unfortunately i am getting debug @ this line.

With Worksheets(.Cells(x, "A").Value)

the first tab "banana"got created and it placed the first banana and
the
number 10 on the tab






"Rick Rothstein (MVP - VB)" wrote:

Assuming the sheet these items are on is named "Sheet1" and that the
first
fruit is on Row 1, give this macro a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets("Sheet1").Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the
macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab
and
1
apple tap
the second part would copy and past the rows that has the fruit in
side
the
specific tab.

i thanks in advance for the help

actually

playing a littel with the DB

I cant tell what is really happening, because I have 10 fruit entrys now. 3
of them are grapes. number 1, 2 and 7 . the macro is able to add ut the tabs
correctly. but it just addes up the row 1 and row 7 skipping row 2.

I can't thank you enought Rick

"Paulo" wrote:

Rick, You are the man...
It almos worked. i didnt understand very deeply what you just explaned. I am
gonna go trow a little more deeply I am ver new @ this.

this time it worked greate. but it diddnt add the last fruit: Grape to the
grape tab.

the way I think the code is working, it did not go trow the entire colum to
check if there was any other entry of the same fruit to copy and paste into
the tabs.

but i am very gratefull for your help I am learning alot from it.

Paulo
"Rick Rothstein (MVP - VB)" wrote:

I was able to duplicate your problem. It seems I forgot to reset the FoundIt
variable to False at the start of each loop. Because I did not do that, when
it got to "melon", which did not have its own worksheet, the FoundIt
variable was still True from the previous loop that added "apple" so when it
went to copy to the "melon" sheet it thought was there, the error was
generated because that sheet did not really exist. Try this code and see if
it works now...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
FoundIt = False
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
TANKS AGAIN FOR HELPPING OUT.. RICK

my "Sheet1" is called Sheet1
I only have Sheet1 tab, i deleted the others.
and the matrix goes exacly like this.

x, A , B
1,grape, 7
2,grape, 5
3,apple, 6
4,apple, 4
5,melon, 5
6,pineapple, 7
7,grape, 15

whith this new code
the result was:
it added the tab grape, its matrix have only row 1: colum A: grape colum
B: 5
it added tab apple, its matrix have 2 rows, row 1: apple 6 and row 2:
apple 4

and I got debug on the same line.

With Worksheets(.Cells(x, "A").Value)



"Rick Rothstein (MVP - VB)" wrote:

I think the problem **may** be because your data doesn't start on Row 1.
Here is some revised code which allows you to set the data sheet's name
and
the starting row for your data on that sheet via the Const (constant)
statements. Change them to match your conditions and see if that solves
your
problem.

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick



"Paulo" wrote in message
...
Rick , thank you so much for helping out.
I am learning alot from your way of thinking on your code.

I can see some how (since i dont know much about coding) that your code
is
able to tell if the fruit already has a tab or not. thats grate for me
;).

unfortunately i am getting debug @ this line.

With Worksheets(.Cells(x, "A").Value)

the first tab "banana"got created and it placed the first banana and
the
number 10 on the tab






"Rick Rothstein (MVP - VB)" wrote:

Assuming the sheet these items are on is named "Sheet1" and that the
first
fruit is on Row 1, give this macro a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets("Sheet1").Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy, "A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the
macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape tab
and
1
apple tap
the second part would copy and past the rows that has the fruit in
side
the
specific tab.

i thanks in advance for the help

I figured It out,

the macro is coppying and pasting only the first and last fruit of each type
to the tab with that fruit name.

so that means thas each tab will only have max of 2 rows.
if the colum has and 2 type of fruits, grapes and apples 5 rows : apple,
apple , grape, grape, apple. the output will only be 2 tabs with 2 rows.
if you number the apples, as aple 1, 2 and 3. the apple tab would have
apple 1 and apple 3 , skipping aple 2

"Paulo" wrote:

actually

playing a littel with the DB

I cant tell what is really happening, because I have 10 fruit entrys now. 3
of them are grapes. number 1, 2 and 7 . the macro is able to add ut the tabs
correctly. but it just addes up the row 1 and row 7 skipping row 2.

I can't thank you enought Rick

Yes, I just spotted that myself. It seems I had some of my logic screwed up
regarding the selection of the last row on the copy sheets. Here is the
problem I was attempting to get around. when you do this...

LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row

if there is nothing in the column, LastRowOnCopy is assigned a value of 1,
not 0. If there is something in Row 1, and nothing in any of the other rows,
LastRowOnCopy is again assigned a value of 1. The problem was in how I was
handling how to get to the first blank row after the last piece of data when
you get a 1 for both conditions above. I believe I now have the problem
solved. Give this code a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 1

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
FoundIt = False
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) = 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = 0
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy + 1, "A")
End With
Next
End With
End Sub


Rick




"Paulo" wrote in message
...
actually

playing a littel with the DB

I cant tell what is really happening, because I have 10 fruit entrys now.
3
of them are grapes. number 1, 2 and 7 . the macro is able to add ut the
tabs
correctly. but it just addes up the row 1 and row 7 skipping row 2.

I can't thank you enought Rick

"Paulo" wrote:

Rick, You are the man...
It almos worked. i didnt understand very deeply what you just explaned. I
am
gonna go trow a little more deeply I am ver new @ this.

this time it worked greate. but it diddnt add the last fruit: Grape to
the
grape tab.

the way I think the code is working, it did not go trow the entire colum
to
check if there was any other entry of the same fruit to copy and paste
into
the tabs.

but i am very gratefull for your help I am learning alot from it.

Paulo
"Rick Rothstein (MVP - VB)" wrote:

I was able to duplicate your problem. It seems I forgot to reset the
FoundIt
variable to False at the start of each loop. Because I did not do that,
when
it got to "melon", which did not have its own worksheet, the FoundIt
variable was still True from the previous loop that added "apple" so
when it
went to copy to the "melon" sheet it thought was there, the error was
generated because that sheet did not really exist. Try this code and
see if
it works now...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
FoundIt = False
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy,
"A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
TANKS AGAIN FOR HELPPING OUT.. RICK

my "Sheet1" is called Sheet1
I only have Sheet1 tab, i deleted the others.
and the matrix goes exacly like this.

x, A , B
1,grape, 7
2,grape, 5
3,apple, 6
4,apple, 4
5,melon, 5
6,pineapple, 7
7,grape, 15

whith this new code
the result was:
it added the tab grape, its matrix have only row 1: colum A: grape
colum
B: 5
it added tab apple, its matrix have 2 rows, row 1: apple 6 and row
2:
apple 4

and I got debug on the same line.

With Worksheets(.Cells(x, "A").Value)



"Rick Rothstein (MVP - VB)" wrote:

I think the problem **may** be because your data doesn't start on
Row 1.
Here is some revised code which allows you to set the data sheet's
name
and
the starting row for your data on that sheet via the Const
(constant)
statements. Change them to match your conditions and see if that
solves
your
problem.

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy +
1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy,
"A")
End With
Next
End With
End Sub


Rick



"Paulo" wrote in message
...
Rick , thank you so much for helping out.
I am learning alot from your way of thinking on your code.

I can see some how (since i dont know much about coding) that your
code
is
able to tell if the fruit already has a tab or not. thats grate
for me
;).

unfortunately i am getting debug @ this line.

With Worksheets(.Cells(x, "A").Value)

the first tab "banana"got created and it placed the first banana
and
the
number 10 on the tab






"Rick Rothstein (MVP - VB)" wrote:

Assuming the sheet these items are on is named "Sheet1" and that
the
first
fruit is on Row 1, give this macro a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy =
LastRowOnCopy + 1
Worksheets("Sheet1").Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy,
"A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
I have a spreadsheet that has 2 colums and 5 rows

lets say it looks like this...

banana;10
apple;15
grapes;12
grapes;2
banana;7
I woul like to make a macro that
creates a single tab for each different fruit
so I would start with the original sheet 1 and after runing the
macro I
would end up with 4 , the original, plus 1 banana tab, 1 grape
tab
and
1
apple tap
the second part would copy and past the rows that has the fruit
in
side
the
specific tab.

i thanks in advance for the help

Thank You very much for You help rick it worked smootly this time.
I am gonna try to aplly this to my other DB see what whappends.

"Rick Rothstein (MVP - VB)" wrote:

Yes, I just spotted that myself. It seems I had some of my logic screwed up
regarding the selection of the last row on the copy sheets. Here is the
problem I was attempting to get around. when you do this...

LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row

if there is nothing in the column, LastRowOnCopy is assigned a value of 1,
not 0. If there is something in Row 1, and nothing in any of the other rows,
LastRowOnCopy is again assigned a value of 1. The problem was in how I was
handling how to get to the first blank row after the last piece of data when
you get a 1 for both conditions above. I believe I now have the problem
solved. Give this code a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 1

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
FoundIt = False
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) = 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = 0
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy + 1, "A")
End With
Next
End With
End Sub


Rick




"Paulo" wrote in message
...
actually

playing a littel with the DB

I cant tell what is really happening, because I have 10 fruit entrys now.
3
of them are grapes. number 1, 2 and 7 . the macro is able to add ut the
tabs
correctly. but it just addes up the row 1 and row 7 skipping row 2.

I can't thank you enought Rick

"Paulo" wrote:

Rick, You are the man...
It almos worked. i didnt understand very deeply what you just explaned. I
am
gonna go trow a little more deeply I am ver new @ this.

this time it worked greate. but it diddnt add the last fruit: Grape to
the
grape tab.

the way I think the code is working, it did not go trow the entire colum
to
check if there was any other entry of the same fruit to copy and paste
into
the tabs.

but i am very gratefull for your help I am learning alot from it.

Paulo
"Rick Rothstein (MVP - VB)" wrote:

I was able to duplicate your problem. It seems I forgot to reset the
FoundIt
variable to False at the start of each loop. Because I did not do that,
when
it got to "melon", which did not have its own worksheet, the FoundIt
variable was still True from the previous loop that added "apple" so
when it
went to copy to the "melon" sheet it thought was there, the error was
generated because that sheet did not really exist. Try this code and
see if
it works now...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
FoundIt = False
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy + 1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy,
"A")
End With
Next
End With
End Sub


Rick


"Paulo" wrote in message
...
TANKS AGAIN FOR HELPPING OUT.. RICK

my "Sheet1" is called Sheet1
I only have Sheet1 tab, i deleted the others.
and the matrix goes exacly like this.

x, A , B
1,grape, 7
2,grape, 5
3,apple, 6
4,apple, 4
5,melon, 5
6,pineapple, 7
7,grape, 15

whith this new code
the result was:
it added the tab grape, its matrix have only row 1: colum A: grape
colum
B: 5
it added tab apple, its matrix have 2 rows, row 1: apple 6 and row
2:
apple 4

and I got debug on the same line.

With Worksheets(.Cells(x, "A").Value)



"Rick Rothstein (MVP - VB)" wrote:

I think the problem **may** be because your data doesn't start on
Row 1.
Here is some revised code which allows you to set the data sheet's
name
and
the starting row for your data on that sheet via the Const
(constant)
statements. Change them to match your conditions and see if that
solves
your
problem.

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean

Const DataSheetName As String = "Sheet1"
Const StartRowForData As Long = 2

With Worksheets(DataSheetName)
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = StartRowForData To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy = LastRowOnCopy +
1
Worksheets(DataSheetName).Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy,
"A")
End With
Next
End With
End Sub


Rick



"Paulo" wrote in message
...
Rick , thank you so much for helping out.
I am learning alot from your way of thinking on your code.

I can see some how (since i dont know much about coding) that your
code
is
able to tell if the fruit already has a tab or not. thats grate
for me
;).

unfortunately i am getting debug @ this line.

With Worksheets(.Cells(x, "A").Value)

the first tab "banana"got created and it placed the first banana
and
the
number 10 on the tab






"Rick Rothstein (MVP - VB)" wrote:

Assuming the sheet these items are on is named "Sheet1" and that
the
first
fruit is on Row 1, give this macro a try...

Sub ProcessFruit()
Dim x As Long
Dim LastRow As Long
Dim LastRowOnCopy As Long
Dim SheetName As String
Dim WS As Worksheet
Dim FoundIt As Boolean
With Worksheets("Sheet1")
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For x = 1 To LastRow
For Each WS In Worksheets
If .Cells(x, "A").Value = WS.Name Then
FoundIt = True
Exit For
End If
Next
If Not FoundIt Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(x, "A").Value
End If
With Worksheets(.Cells(x, "A").Value)
LastRowOnCopy = .Cells(Rows.Count, "A").End(xlUp).Row
If Len(.Cells(LastRowOnCopy, "A").Value) 0 And _
LastRowOnCopy = 1 Then LastRowOnCopy =
LastRowOnCopy + 1
Worksheets("Sheet1").Rows(x).EntireRow.Copy _
Destination:=.Cells(LastRowOnCopy,
"A")
End With
Next
End With
End Sub


Rick