| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
I wnat to copy several Worksheets, Several Times...
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
I wnat to copy several Worksheets, Several Times...
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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
I wnat to copy several Worksheets, Several Times...
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 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
I wnat to copy several Worksheets, Several Times...
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 |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
I wnat to copy several Worksheets, Several Times...
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 worksheet. 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 worksheet 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 Worksheet Tab. 5) On each work sheet 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 columns 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) 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 |
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
I wnat to copy several Worksheets, Several Times...
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 _ Befo=Worksheets(1) ActiveSheet.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 worksheet. 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 worksheet 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 Worksheet Tab. 5) On each work sheet 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 columns 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) 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 |
|
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
I wnat to copy several Worksheets, Several Times...
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 laymans 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 worksheet and calls it Summary. Cell A1 is active but the cells A1:L1 were not merged and the cell formatting hasnt 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 _ Befo=Worksheets(1) ActiveSheet.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 worksheet. 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 worksheet 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 Worksheet Tab. 5) On each work sheet 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 columns 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) 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 |
|
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
I wnat to copy several Worksheets, Several Times...
The code isn't running because the summary sheet 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 _ Befo=Worksheets(1) ActiveSheet.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 laymans 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 worksheet and calls it Summary. Cell A1 is active but the cells A1:L1 were not merged and the cell formatting hasnt 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 _ Befo=Worksheets(1) ActiveSheet.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 worksheet. 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 worksheet 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 Worksheet Tab. 5) On each work sheet 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 columns 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) 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 |
|
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
I wnat to copy several Worksheets, Several Times...
Joel:
I had run the previous code both with an existing summary sheet as well as without one, the result was the same. If I run the new code from within the VBA Editor, I get a I get a Microsoft Visual Basic Run-time Error box with Run-time error '1004: Application-defined or Object-defined error" in it. If I run the macro from within Excel, I get the same result as with the previous code. I get a Microsoft Visual Basic Error box with 400 in it. The line that is highlighted is the very first line, "Sub addsummary()" The result was the same rather I started with a summary sheet or without a summary sheet. "Joel" wrote: The code isn't running because the summary sheet 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 _ Befo=Worksheets(1) ActiveSheet.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 laymans 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 worksheet and calls it Summary. Cell A1 is active but the cells A1:L1 were not merged and the cell formatting hasnt 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 _ Befo=Worksheets(1) ActiveSheet.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 worksheet. 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 worksheet 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 Worksheet Tab. 5) On each work sheet 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 columns 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) 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 |
|
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 worksheet. I ran with no errors. I also ran it a 2nd time after the summary sheet 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 worksheet. Also make sure no other workbooks are opened. "Joel" wrote: The code isn't running because the summary sheet 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 _ Befo=Worksheets(1) ActiveSheet.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 laymans 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 worksheet and calls it Summary. Cell A1 is active but the cells A1:L1 were not merged and the cell formatting hasnt 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 _ Befo=Worksheets(1) ActiveSheet.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 worksheet. 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 worksheet 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 Worksheet Tab. 5) On each work sheet 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 columns 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) 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 |
|
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
I wnat to copy several Worksheets, Several Times...
Joel:
I get similar results when running on a blank workbook. (With no other Excel files open.) Are there any common Option settings, I should address, If not I will speak with an IT specialist and get his opinion. I may have a local setting on my machine which causes the Run-time error. Once again, you've been very helpful. Thank You. Darrell "Joel" wrote: I just copied the updated code I post on 7/31/2007 12:49 PM PST and put it into a blank worksheet. I ran with no errors. I also ran it a 2nd time after the summary sheet 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 worksheet. Also make sure no other workbooks are opened. "Joel" wrote: The code isn't running because the summary sheet 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 _ Befo=Worksheets(1) ActiveSheet.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 laymans 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 worksheet and calls it Summary. Cell A1 is active but the cells A1:L1 were not merged and the cell formatting hasnt 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 _ Befo=Worksheets(1) ActiveSheet.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 worksheet. 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 worksheet 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 Worksheet Tab. 5) On each work sheet 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 columns 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) 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" |
|
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
I wnat to copy several Worksheets, Several Times...
I'm running with Excel 2003. It may be some of the problems posted on 2007???
"Dr. Darrell" wrote: Joel: I get similar results when running on a blank workbook. (With no other Excel files open.) Are there any common Option settings, I should address, If not I will speak with an IT specialist and get his opinion. I may have a local setting on my machine which causes the Run-time error. Once again, you've been very helpful. Thank You. Darrell "Joel" wrote: I just copied the updated code I post on 7/31/2007 12:49 PM PST and put it into a blank worksheet. I ran with no errors. I also ran it a 2nd time after the summary sheet 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 worksheet. Also make sure no other workbooks are opened. "Joel" wrote: The code isn't running because the summary sheet 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 _ Befo=Worksheets(1) ActiveSheet.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 laymans 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 worksheet and calls it Summary. Cell A1 is active but the cells A1:L1 were not merged and the cell formatting hasnt 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 _ Befo=Worksheets(1) ActiveSheet.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 worksheet. 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 worksheet 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 Worksheet Tab. 5) On each work sheet 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 columns 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) 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() |
|
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
I wnat to copy several Worksheets, Several Times...
Joel:
I am also running 2003. Darrell "Joel" wrote: I'm running with Excel 2003. It may be some of the problems posted on 2007??? "Dr. Darrell" wrote: Joel: I get similar results when running on a blank workbook. (With no other Excel files open.) Are there any common Option settings, I should address, If not I will speak with an IT specialist and get his opinion. I may have a local setting on my machine which causes the Run-time error. Once again, you've been very helpful. Thank You. Darrell "Joel" wrote: I just copied the updated code I post on 7/31/2007 12:49 PM PST and put it into a blank worksheet. I ran with no errors. I also ran it a 2nd time after the summary sheet 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 worksheet. Also make sure no other workbooks are opened. "Joel" wrote: The code isn't running because the summary sheet 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 _ Befo=Worksheets(1) ActiveSheet.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 laymans 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 worksheet and calls it Summary. Cell A1 is active but the cells A1:L1 were not merged and the cell formatting hasnt 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 _ Befo=Worksheets(1) ActiveSheet.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 worksheet. 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 worksheet 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 Worksheet Tab. 5) On each work sheet 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 columns 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) 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 |
|
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
I wnat to copy several Worksheets, Several Times...
Joel:
You have been a great help. The code you provided me directed me in the right direction. With a little analysis and experimentation, I altered your code to look like this: (It appeared that I had to add ActiveSheet to many lines. 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 _ Befo=Worksheets(1) ActiveSheet.Name = "Summary" End If ActiveSheet.Range("A1:L1").Select With Selection ..MergeCells = True ..Name = "Arial" ..Font.Size = 24 ..Font.ColorIndex = 2 ..Interior.ColorIndex = 1 ..Value = ActiveWorkbook.Name ' Puts the filename into the cell ..Replace What:=".xls", Replacement:="" ' Removes ".xls" extension from filename End With With Sheets(2) ActiveSheet.Range("B2") = .Range("S8") ActiveSheet.Range("C2") = .Range("T8") ActiveSheet.Range("D2") = .Range("U8") ActiveSheet.Range("E2") = .Range("V8") ActiveSheet.Range("F2") = .Range("W8") ActiveSheet.Range("G2") = .Range("X8") ActiveSheet.Range("H2") = .Range("Z8") ActiveSheet.Range("I2") = .Range("AA8") ActiveSheet.Range("J2") = .Range("AC8") ActiveSheet.Range("K2") = .Range("AD8") ActiveSheet.Range("L2") = .Range("AE8") End With numberSheets = ActiveWorkbook.Worksheets.Count RowCount = 3 For wsCounter = 2 To numberSheets With Sheets(wsCounter) totalRow = .Columns("A:A").Find(What:="Totals", LookIn:=xlValues).Row 'Searches all of Column A for "Totals" and sets rowTotal to the row number on which it appears ActiveSheet.Cells(RowCount, "A") = .Name ActiveSheet.Cells(RowCount, "B") = .Cells(totalRow, "S") ActiveSheet.Cells(RowCount, "C") = .Cells(totalRow, "T") ActiveSheet.Cells(RowCount, "D") = .Cells(totalRow, "U") ActiveSheet.Cells(RowCount, "E") = .Cells(totalRow, "V") ActiveSheet.Cells(RowCount, "F") = .Cells(totalRow, "W") ActiveSheet.Cells(RowCount, "G") = .Cells(totalRow, "X") ActiveSheet.Cells(RowCount, "H") = .Cells(totalRow, "Z") ActiveSheet.Cells(RowCount, "I") = .Cells(totalRow, "AA") ActiveSheet.Cells(RowCount, "J") = .Cells(totalRow, "AC") ActiveSheet.Cells(RowCount, "K") = .Cells(totalRow, "AD") ActiveSheet.Cells(RowCount, "L") = .Cells(totalRow, "AE") End With RowCount = RowCount + 1 Next wsCounter End Sub "Joel" wrote: I'm running with Excel 2003. It may be some of the problems posted on 2007??? "Dr. Darrell" wrote: Joel: I get similar results when running on a blank workbook. (With no other Excel files open.) Are there any common Option settings, I should address, If not I will speak with an IT specialist and get his opinion. I may have a local setting on my machine which causes the Run-time error. Once again, you've been very helpful. Thank You. Darrell "Joel" wrote: I just copied the updated code I post on 7/31/2007 12:49 PM PST and put it into a blank worksheet. I ran with no errors. I also ran it a 2nd time after the summary sheet 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 worksheet. Also make sure no other workbooks are opened. "Joel" wrote: The code isn't running because the summary sheet 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 _ Befo=Worksheets(1) ActiveSheet.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 laymans 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 worksheet and calls it Summary. Cell A1 is active but the cells A1:L1 were not merged and the cell formatting hasnt 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 _ Befo=Worksheets(1) ActiveSheet.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 worksheet. 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 worksheet 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 Worksheet Tab. 5) On each work sheet 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 columns 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) 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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Adding times on different worksheets in same file | Excel Worksheet Functions | |||
| wnat to extract first & last names in sep cols from name list in 1 | Excel Worksheet Functions | |||
| Bold and formated cell wnat to delete in one stroke | Excel Discussion (Misc queries) | |||
| How do i use the same name multiple times in repeating worksheets | Excel Discussion (Misc queries) | |||
| Count # of times value "x" appear across multiple worksheets | Excel Worksheet Functions | |||
Linear Mode
