Subject: Macro- Copy same rows into own worksheets
 

I need a macro or VBA to Copy Same Rows Data in A:A into their own
Worksheets with the same row name.

From a list in column A in sheet1 that has the multiple rows of same name
and I want to creates a worksheets named by that row name. Names are always
A,B,C



Example:
Worksheet SHEET1

a

a

a

b

b

b

c

c

c


(save worksheet: sheet1)



Worksheet: a Worksheet: b Worksheet: c

a b c

a b c

a b c

Subject: Macro- Copy same rows into own worksheets
 

Hi LesleyC

See this page for example code
http://www.rondebruin.nl/copy5.htm

--
Regards Ron de Bruin
http://www.rondebruin.nl



"LesleyC" wrote in message ...
I need a macro or VBA to Copy Same Rows Data in A:A into their own Worksheets with the same row name.

From a list in column A in sheet1 that has the multiple rows of same name and I want to creates a worksheets named by that row
name. Names are always A,B,C



Example:
Worksheet SHEET1

a

a

a

b

b

b

c

c

c


(save worksheet: sheet1)



Worksheet: a Worksheet: b Worksheet: c

a b c

a b c

a b c

Subject: Macro- Copy same rows into own worksheets
 

"LesleyC" wrote in message
...
I need a macro or VBA to Copy Same Rows Data in A:A into their own
Worksheets with the same row name.

From a list in column A in sheet1 that has the multiple rows of same name
and I want to creates a worksheets named by that row name. Names are
always
A,B,C
<snip example layout

'copy raw invoice data to working tab and add a sheet for each row name
Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Data"
Sheets.Add.Name = "A"
Sheets.Add.Name = "B"
Sheets.Add.Name = "C"
'copy title row to new sheets
For Each WS In Worksheets(Array("A", "B", "C"))
WS.Range("A1:G1").Value = Sheets("Data").Range("A1:G1").Value 'adjust range
for your title row
Next
'seperate data to corresponding sheet
Sheets("Data").Activate
For Each cell In Range("A1:A" & Range("A65536").End(xlUp).Row) 'loop thru
cells w/data
Select Case cell.Value
Case "A": cell.EntireRow.Cut
Sheets("A").Range("A65536").End(xlUp).Offset(1, 0)
Case "B": cell.EntireRow.Cut
Sheets("B").Range("A65536").End(xlUp).Offset(1, 0)
Case "C": cell.EntireRow.Cut
Sheets("C").Range("A65536").End(xlUp).Offset(1, 0)
End Select
Next
'optionally remove sheets("Data") without bothering user since its now empty
Application.DisplayAlerts = False
Sheets("Data").Delete
Application.DisplayAlerts = True
end sub