Sorry it does not



"Mike H" wrote:

Hi,

Right click the sheet tab of the sheet that contains this data, view code
and paste this in. It will copy the data to sheet 2 and sheet 3

Sub stance()
Dim MyRange As Range, AppleRange As Range, OrangeRange As Range
Dim BuildRange As Range
Lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set MyRange = Range("A1:A" & Lastrow)
For Each c In MyRange
Select Case UCase(c.Value)
Case Is = "APPLE"
If AppleRange Is Nothing Then
Set AppleRange = c.EntireRow
Else
Set AppleRange = Union(AppleRange, c.EntireRow)
End If
Case Is = "ORANGE"
If OrangeRange Is Nothing Then
Set OrangeRange = c.EntireRow
Else
Set OrangeRange = Union(OrangeRange, c.EntireRow)
End If
Case Else
End Select
Next

If Not AppleRange Is Nothing Then
AppleRange.Copy Destination:=Sheets("Sheet2").Range("A1")
End If

If Not OrangeRange Is Nothing Then
OrangeRange.Copy Destination:=Sheets("Sheet3").Range("A1")
End If
End Sub

Mike



Mike

"George A. Jululian" wrote:

Hi all,

I have worksheet full of data and I need your help

I Need a macro (VBA) to sort them all and to remove the entire rows for
Apple, Banana and put them in sheet separate


Apple 5 6 7 8
Banana 4 3 5 87
Appel 5 6 7 8
Appel 5 6 7 8
Banana 4 3 5 87
Appel 5 6 7 8
Appel 5 6 7 8
Orange 11 3 55 2
Appel 5 6 7 8
Appel 5 6 7 8
Orange 11 3 55 2

Please help