Subject: Macro- Copy same rows into own worksheets

[LesleyC]

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

 

[Ron de Bruin]

Hi LesleyC

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

 

[Jef Gorbach]

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