I knew you would ask to sort the sheets after I sent the last posting. I was
leaving work and didn't have time to make the change. this code solves your
problem. It was simple. I did things backwards.

Sub copysheets()

Dim colorarray As Variant
colorarray = Array(3, 4, 5, 6)

Numbersheets = Worksheets.Count

For wscounter = Numbersheets To 1 Step -1

Worksheets(wscounter).Copy _
After:=Worksheets(wscounter)
ActiveSheet.Range("M8") = 20
ActiveSheet.Name = _
Sheets(wscounter).Name & " 20 Ea"
ActiveSheet.Tab.ColorIndex = 3

Worksheets(wscounter).Copy _
After:=Worksheets(wscounter)
ActiveSheet.Range("M8") = 10
ActiveSheet.Name = _
Sheets(wscounter).Name & " 10 Ea"
ActiveSheet.Tab.ColorIndex = 4

Worksheets(wscounter).Copy _
After:=Worksheets(wscounter)
ActiveSheet.Range("M8") = 5
ActiveSheet.Name = _
Sheets(wscounter).Name & " 5 Ea"
ActiveSheet.Tab.ColorIndex = 5

Sheets(wscounter).Range("M8") = 1
Sheets(wscounter).Name = Sheets(wscounter).Name & " 1 Ea"
Sheets(wscounter).Tab.ColorIndex = 6

Next wscounter
End Sub


"Dr. Darrell" wrote:

Joel:

Thank you very much, that worked very nicely. Everything I asked for
happened (the first time.)

The result left me with a considerable amount of manual work to do. I need
to drag Tabs to logical locations and re-color the tabs.

1) The copies of the worksheets were places at the end worksheet list. My
original list of worksheets is similar to this:

Item 00001, 3" Valve, Item 00007, 3" Valve... Item 00011, 2.5" Valve, Item
00016, 2.5" Valve ...

I would like them to be in sequential order (sort of) like the following

Item 00001, 3" Valve 1 Ea, Item 00001, 3" Valve 5 Ea, Item 00001, 3" Valve
10 Ea, Item 00001, 3" Valve 20 Ea... Item 00011, 2.5 1 Ea" Valve, Item 00011,
2.5" Valve 5 Ea, Item 00011, 2.5 10 Ea" Valve, Item 00011, 2.5" Valve 20 Ea,
...


2) All the Tab Colors were copied from the original Tab Color.

I would like all the "... 1 Ea" tabs to be the same color, All the "...5 Ea"
Tabs be the same color but different from the "...1 Ea" Tabs and similar for
"...10 Ea" and "... 20 Ea" Tabs.

Can the code be easily modified to do the above actions.

Darrell


"Joel" wrote:

Sub copysheets()

Numbersheets = Worksheets.Count

For wscounter = 1 To Numbersheets

Worksheets(wscounter).Copy _
After:=Worksheets(Numbersheets)
ActiveSheet.Range("M8") = 5
ActiveSheet.Name = _
Sheets(wscounter).Name & " 5 Ea"

Worksheets(wscounter).Copy _
After:=Worksheets(Numbersheets)
ActiveSheet.Range("M8") = 10
ActiveSheet.Name = _
Sheets(wscounter).Name & " 10 Ea"

Worksheets(wscounter).Copy _
After:=Worksheets(Numbersheets)
ActiveSheet.Range("M8") = 20
ActiveSheet.Name = _
Sheets(wscounter).Name & " 20 Ea"

Sheets(wscounter).Range("M8") = 1
Sheets(wscounter).Name = Sheets(wscounter).Name & " 1 Ea"
Next wscounter
End Sub


"Dr. Darrell" wrote:

I have 17 work sheets in one workbook all labeled similar to this; <<< Item
00001, 3" Valve

I want to do the following:

1) Copy each work sheet 4 times.
a. Rename the originals with an appendage of €œ1 Ea€�; <<< Item 00001, 3"
Valve
b. Rename each of the copies with an appendage of €œ5 Ea€�, €œ10 Ea€� and
€œ20 Ea€�
2) Change the value of Cell M8 in each new worksheet to be 5, 10 and 20 to
correspond to the names of the new worksheets.

I know how to do this by copying the worksheets and renaming them and typing
the value into M8.

Can this be easily done through VBA and what should I use for code?

Darrell