Help on a macro code please.

Have a worksheet such as below:

A B C D
GLASS 1 YES DONE
CUP 2 NO IN PROGRESS
CHAIR 3 NO DONE
CUP 4 NO IN PROGRESS
GLASS 5 YES DONE

I want to have a macro to copy the entire row to a new worksheet such that
if COLUMN A contains the word "GLASS" it will copy the entire row to
worksheet named "GLASS" and "CUP" to a new worksheet named "CUP" and so on
and so fort... can this be done? THANKS!

I would use data>filter>autofilter>filter on glass>copy/paste. Record a
macro and clean it up.
For glass you say to an existing? sheet and cup to a NEW? sheet???

--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(E-Mail Removed)
"Rachel" <(E-Mail Removed)> wrote in message
newsFEB4741-5B3B-4DAA-BB94-(E-Mail Removed)...
> Help on a macro code please.
>
> Have a worksheet such as below:
>
> A B C D
> GLASS 1 YES DONE
> CUP 2 NO IN PROGRESS
> CHAIR 3 NO DONE
> CUP 4 NO IN PROGRESS
> GLASS 5 YES DONE
>
> I want to have a macro to copy the entire row to a new worksheet such that
> if COLUMN A contains the word "GLASS" it will copy the entire row to
> worksheet named "GLASS" and "CUP" to a new worksheet named "CUP" and so on
> and so fort... can this be done? THANKS!

try this

Sub copy_it()

Dim i As Integer, rng1 As Integer, rng As Integer

acn = ActiveSheet.Name
rng = cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To rng
cells(i, "A").Select
ActiveCell.EntireRow.Copy
Sheets(cells(i, "A").Value).Select
rng1 = cells(Rows.Count, "A").End(xlUp).Row + 1
cells(rng1, "A").Select
ActiveSheet.Paste
Sheets(acn).Activate
Next
Application.CutCopyMode = False

End Sub


On Jun 28, 5:55*pm, Rachel <Rac...@discussions.microsoft.com> wrote:
> Help on a macro code please.
>
> Have a worksheet such as below:
>
> A * * * * * * * B * * * * * * C * * * ** *D
> GLASS * * 1 * * * * * *YES * * * * DONE
> CUP * * * * 2 * * * * * *NO * * * * * IN PROGRESS
> CHAIR * * 3 * * * * * *NO * * * * *DONE
> CUP * * * * 4 * * * * * *NO * * * * * IN PROGRESS
> GLASS * * 5 * * * * * YES * * * * *DONE
>
> I want to have a macro to copy the entire row to a new worksheet such that
> if COLUMN A contains the word "GLASS" it will copy the entire row to
> worksheet named "GLASS" and "CUP" to a new worksheet named "CUP" and so on
> and so fort... can this be done? THANKS!

HI Don,

Thanks for this but i dont really know how to record a macro
What I mean is that it copies each values in column A to a worsheet named
after that values. i.e GLASS to worksheet "GLASS" and CUP to worksheet "CUP"
et al. THANKS!

"Don Guillett" wrote:

> I would use data>filter>autofilter>filter on glass>copy/paste. Record a
> macro and clean it up.
> For glass you say to an existing? sheet and cup to a NEW? sheet???
>
> --
> Don Guillett
> Microsoft MVP Excel
> SalesAid Software
> (E-Mail Removed)
> "Rachel" <(E-Mail Removed)> wrote in message
> newsFEB4741-5B3B-4DAA-BB94-(E-Mail Removed)...
> > Help on a macro code please.
> >
> > Have a worksheet such as below:
> >
> > A B C D
> > GLASS 1 YES DONE
> > CUP 2 NO IN PROGRESS
> > CHAIR 3 NO DONE
> > CUP 4 NO IN PROGRESS
> > GLASS 5 YES DONE
> >
> > I want to have a macro to copy the entire row to a new worksheet such that
> > if COLUMN A contains the word "GLASS" it will copy the entire row to
> > worksheet named "GLASS" and "CUP" to a new worksheet named "CUP" and so on
> > and so fort... can this be done? THANKS!
>
>

Rachel,
I think this code will do what you want - Paste both the procedure &
function in a standard module. The worksheet which stores your data must have
Column headings otherwise code may fail.

Sub FilterDataToSheets()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim lr As Integer
Dim c As Range

'worksheet where your data is stored
'change Sheet1 name as required
Set ws1 = ThisWorkbook.Worksheets("Sheet1")

With ws1

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


Set rng = .Range("A1" & lr)

'extract list
.Columns("A:A").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("J1"), Unique:=True

lr = .Cells(.Rows.Count, "J").End(xlUp).Row

'set up Criteria Area
.Range("L1").Value = .Range("A1").Value

For Each c In .Range("J2:J" & lr)
'add the name to the criteria area
.Range("L2").Value = c.Value

'sheet aleady exists
If SheetExists(c.Value) Then
Sheets(c.Value).Cells.Clear
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("L1:L2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False
Else
'add new sheet and run advanced filter
Set wsNew = Sheets.Add
wsNew.Move After:=Worksheets(Worksheets.Count)
wsNew.Name = c.Value
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("L1:L2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If


Next

.Select
.Columns("J:L").Delete

End With
End Sub

Function SheetExists(wksName As String) As Boolean
On Error Resume Next
SheetExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function



jb


"Rachel" wrote:

> Help on a macro code please.
>
> Have a worksheet such as below:
>
> A B C D
> GLASS 1 YES DONE
> CUP 2 NO IN PROGRESS
> CHAIR 3 NO DONE
> CUP 4 NO IN PROGRESS
> GLASS 5 YES DONE
>
> I want to have a macro to copy the entire row to a new worksheet such that
> if COLUMN A contains the word "GLASS" it will copy the entire row to
> worksheet named "GLASS" and "CUP" to a new worksheet named "CUP" and so on
> and so fort... can this be done? THANKS!

Hi Rachel

See
http://www.rondebruin.nl/copy5.htm

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm




"Rachel" <(E-Mail Removed)> wrote in message newsFEB4741-5B3B-4DAA-BB94-(E-Mail Removed)...
> Help on a macro code please.
>
> Have a worksheet such as below:
>
> A B C D
> GLASS 1 YES DONE
> CUP 2 NO IN PROGRESS
> CHAIR 3 NO DONE
> CUP 4 NO IN PROGRESS
> GLASS 5 YES DONE
>
> I want to have a macro to copy the entire row to a new worksheet such that
> if COLUMN A contains the word "GLASS" it will copy the entire row to
> worksheet named "GLASS" and "CUP" to a new worksheet named "CUP" and so on
> and so fort... can this be done? THANKS!