RE: I wnat to copy several Worksheets, Several Times...

I just copied the updated code I post on 7/31/2007 12:49 PM PST and put it
into a blank work***. I ran with no errors. I also ran it a 2nd time
after the summary *** was created and again there wre no errors. Try the
same and see what happens. The problem may have to do with some data that
exists on the work***. Also make sure no other workbooks are opened.

"Joel" wrote:

The code isn't running because the summary *** already exists. I knew this
was going to be a problem if you ran the code more than once. I should of
put this fix in from the beginning. if the code still fails let me know
which line is colored. VB stop on an error and highlights the fail line.



Sub addsummary()

'test for summary
found = False
For Each ws In Worksheets
If ws.Name = "Summary" Then
found = True
Exit For
End If
Next ws
If found = True Then
Sheets("Summary").Activate
Else
Worksheets.Add _
Before:=Worksheets(1)
Active***.Name = "Summary"
End If
Range("A1:L1").Select
With Selection
.MergeCells = True
.Name = "Arial"
.Font.Size = 24
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
With Sheets(2)
Range("B2") = .Range("S8")
Range("C2") = .Range("T8")
Range("D2") = .Range("U8")
Range("E2") = .Range("V8")
Range("F2") = .Range("W8")
Range("G2") = .Range("X8")
Range("H2") = .Range("Z8")
Range("I2") = .Range("AA8")
Range("J2") = .Range("AC8")
Range("K2") = .Range("AD8")
Range("L2") = .Range("AE8")

End With

RowCount = 3
For wscounter = 2 To Numbersheets
With Sheets(wscounter)
TotalRow = Columns("$A:$A").Find("Total", xlValues).Row
Cells(RowCount, "A") = .Name
Cells(RowCount, "B") = .Cells(TotalRow, "S")
Cells(RowCount, "C") = .Cells(TotalRow, "T")
Cells(RowCount, "D") = .Cells(TotalRow, "U")
Cells(RowCount, "E") = .Cells(TotalRow, "V")
Cells(RowCount, "F") = .Cells(TotalRow, "W")
Cells(RowCount, "G") = .Cells(TotalRow, "X")
Cells(RowCount, "H") = .Cells(TotalRow, "Y")
Cells(RowCount, "I") = .Cells(TotalRow, "Z")
Cells(RowCount, "J") = .Cells(TotalRow, "AA")
Cells(RowCount, "K") = .Cells(TotalRow, "AB")
Cells(RowCount, "L") = .Cells(TotalRow, "AC")
Cells(RowCount, "M") = .Cells(TotalRow, "AD")

End With

RowCount = RowCount + 1
Next wscounter

End Sub

"Dr. Darrell" wrote:

Joel:

You'll think I'm completely inept, (you're probably not far from the
mark!!!).

I reviewed the code you typed and from a layman’s eye it makes sense.

However, when I run it, I get a Microsoft Visual Basic Error box with “400”
in it.

The code does create the work*** and calls it “Summary”.

Cell A1 is active but the cells A1:L1 were not merged and the cell
formatting hasn’t changed.

It appears that nothing beyond the .MergeCells command happened.

Is there a syntax error either with the Selection of the Range or with the
.MergeCells command?

Darrell


"Joel" wrote:

It is better as a seperate function. Check the cell that are copied to make
sure they are correct. I think there may be some typos in your request.
Make changes as necessary

Sub addsummary()

Worksheets.add _
Before:=Worksheets(1)
Active***.Name = "Summary"
Range("A1:L1").Select
With Selection
.MergeCells = True
.Name = "Arial"
.Font.Size = 24
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
With Sheets(2)
Range("B2") = .Range("S8")
Range("C2") = .Range("T8")
Range("D2") = .Range("U8")
Range("E2") = .Range("V8")
Range("F2") = .Range("W8")
Range("G2") = .Range("X8")
Range("H2") = .Range("Z8")
Range("I2") = .Range("AA8")
Range("J2") = .Range("AC8")
Range("K2") = .Range("AD8")
Range("L2") = .Range("AE8")

End With

RowCount = 3
For wscounter = 2 To Numbersheets
With Sheets(wscounter)
TotalRow = Columns("$A:$A").Find("Total", xlValues).Row
Cells(RowCount, "A") = .Name
Cells(RowCount, "B") = .Cells(TotalRow, "S")
Cells(RowCount, "C") = .Cells(TotalRow, "T")
Cells(RowCount, "D") = .Cells(TotalRow, "U")
Cells(RowCount, "E") = .Cells(TotalRow, "V")
Cells(RowCount, "F") = .Cells(TotalRow, "W")
Cells(RowCount, "G") = .Cells(TotalRow, "X")
Cells(RowCount, "H") = .Cells(TotalRow, "Y")
Cells(RowCount, "I") = .Cells(TotalRow, "Z")
Cells(RowCount, "J") = .Cells(TotalRow, "AA")
Cells(RowCount, "K") = .Cells(TotalRow, "AB")
Cells(RowCount, "L") = .Cells(TotalRow, "AC")
Cells(RowCount, "M") = .Cells(TotalRow, "AD")

End With

RowCount = RowCount + 1
Next wscounter


End Sub

"Dr. Darrell" wrote:

Joel:

You are the best.

Thank You.

I have one more task to do in this WorkBook, and I will post this as another
entry as well as in response to you.

1) I would like to create a summary work***.

2) I would like to merge Cells A1:L1 and enter the File Name (without the
extension). Formatted Arial,Bold,White,24pt text with Black background.

3) In Cells B2:M2 I would like to enter the values from the first work***
Cells # S8, T8, U8, V8, W8, X8, Z8, AA8, AC8, AD8 and AE8

4) In Column A3:A70, I would like to enter the text from each Work*** Tab.

5) On each work *** there is a value in Column A of “totals”. In these
work sheets, it happens to be on Line 97, 98 or 59.

a. On each line representing each Tab Name, in columns B through M, I would
like to enter the values of column’s S, T, U, V, W, X, Z, AA, AC, AD and AE
from the lines that contain the value “totals” in column A for each of those
worksheets.

Can the existing code be easily modified, or should this be a separate
subroutine?

Darrell


Darrell

"Joel" wrote:

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)
Active***.Range("M8") = 20
Active***.Name = _
Sheets(wscounter).Name & " 20 Ea"
Active***.Tab.ColorIndex = 3

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

Worksheets(wscounter).Copy _
After:=Worksheets(wscounter)
Active***.Range("M8") = 5
Active***.Name = _
Sheets(wscounter).Name & " 5 Ea"
Active***.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)
Active***.Range("M8") = 5
Active***.Name = _
Sheets(wscounter).Name & " 5 Ea"

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

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

Sheets(wscounter).Range("M8") = 1
.