| 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 |
| 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 | |||
Hybrid Mode
