![]() |
How? Macro to copy range to new worksheet, name new worksheet, loop
Hello Excel Experts,
I'm looking for a macro that can copy range A2:G2 in the worksheet "setup" to a new worksheet, name the new worksheet according to the value in cell A2, and then repeat the procedure for the next row (A3:G3). The macro should continue to run until all rows with data in "setup" have been copied to new sheets. "Nice to have" but not necessary would be a step to copy the header row of "setup" A1:G1 to each of the new sheets at the top. I found macros in this group to copy the range and create a worksheet, and a looping macro to create new worksheets based on a list, but I can't figure out how to combine the two. I've posted them below. (is it proper netiquette to name the people who posted them originally?) Any help would be greatly appreciated. Thanks, E. Kohl Sub CopyRange() Dim ws As Worksheet, ws1 As Worksheet, c As Range Set ws = ActiveSheet Set c = ActiveCell Set ws1 = Sheets.Add ws.Range("A2:G2").Copy ws1.Range("A1") ws1.Name = ws1.Range("A1") ws.Select c.Select End Sub Sub nameSheetsFromSheet() Dim vNames() As Variant Dim Cntr As Long Dim wbNew As Worksheet vNames() = Worksheets("Setup").Range("A2:A" & Worksheets("Setup") _ .Range("B65536").End(xlUp).Row).Value For Cntr = 1 To UBound(vNames()) Set wbNew = ThisWorkbook.Worksheets.Add wbNew.Name = vNames(Cntr, 1) Set wbNew = Nothing Next Cntr End Sub |
How? Macro to copy range to new worksheet, name new worksheet, loop
E
Try this macro Sub MakeSheets() Dim cell As Range Dim Rng As Range Dim wsh As Worksheet Set Rng = Sheet1.Range("a2", Sheet1.Range("A2").End(xlDown)) 'Loop through cells For Each cell In Rng.Cells 'Create new sheet Set wsh = ThisWorkbook.Worksheets.Add(, _ ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) 'Copy header row cell.Offset(-cell.Row + 1, 0).Resize(, 7).Copy _ wsh.Range("a1") 'Copy data row cell.Resize(, 7).Copy _ wsh.Range("A65536").End(xlUp).Offset(1, 0) Next cell End Sub -- Dick Kusleika MVP - Excel www.dicks-clicks.com Post all replies to the newsgroup. "Repoman" wrote in message om... Hello Excel Experts, I'm looking for a macro that can copy range A2:G2 in the worksheet "setup" to a new worksheet, name the new worksheet according to the value in cell A2, and then repeat the procedure for the next row (A3:G3). The macro should continue to run until all rows with data in "setup" have been copied to new sheets. "Nice to have" but not necessary would be a step to copy the header row of "setup" A1:G1 to each of the new sheets at the top. I found macros in this group to copy the range and create a worksheet, and a looping macro to create new worksheets based on a list, but I can't figure out how to combine the two. I've posted them below. (is it proper netiquette to name the people who posted them originally?) Any help would be greatly appreciated. Thanks, E. Kohl Sub CopyRange() Dim ws As Worksheet, ws1 As Worksheet, c As Range Set ws = ActiveSheet Set c = ActiveCell Set ws1 = Sheets.Add ws.Range("A2:G2").Copy ws1.Range("A1") ws1.Name = ws1.Range("A1") ws.Select c.Select End Sub Sub nameSheetsFromSheet() Dim vNames() As Variant Dim Cntr As Long Dim wbNew As Worksheet vNames() = Worksheets("Setup").Range("A2:A" & Worksheets("Setup") _ .Range("B65536").End(xlUp).Row).Value For Cntr = 1 To UBound(vNames()) Set wbNew = ThisWorkbook.Worksheets.Add wbNew.Name = vNames(Cntr, 1) Set wbNew = Nothing Next Cntr End Sub |
How? Macro to copy range to new worksheet, name new worksheet, loop
E
I forgot to rename the sheet. See code below for change Sub MakeSheets() Dim cell As Range Dim Rng As Range Dim wsh As Worksheet Set Rng = Sheet1.Range("a2", Sheet1.Range("A2").End(xlDown)) 'Loop through cells For Each cell In Rng.Cells 'Create new sheet Set wsh = ThisWorkbook.Worksheets.Add(, _ ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) 'Copy header row cell.Offset(-cell.Row + 1, 0).Resize(, 7).Copy _ wsh.Range("a1") 'Copy data row cell.Resize(, 7).Copy _ wsh.Range("A65536").End(xlUp).Offset(1, 0) On Error Resume Next wsh.Name = wsh.Range("A2").Value On Error Goto 0 Next cell End Sub -- Dick Kusleika MVP - Excel www.dicks-clicks.com Post all replies to the newsgroup. |
How? Macro to copy range to new worksheet, name new worksheet, loop
Hi Swenk,
Thanks for the quick reply. I follow what you're saying and I will use your code to name the worksheets; however, I still don't know how to integrate the looping code of the second macro into the copy code of the first macro. Perhaps I didn't explain it well enough: The first macro copies a range to a new worksheet and names the worksheet according to the value in A1. It does not loop at all: Sub CopyRange() Dim ws As Worksheet, ws1 As Worksheet, c As Range Set ws = ActiveSheet Set c = ActiveCell Set ws1 = Sheets.Add ws.Range("A2:G2").Copy ws1.Range("A1") ws1.Name = ws1.Range("A1") ws.Select c.Select End Sub This macro "loops" by going through a list and creating new sheets until the list is finished (please note that the two macros are from different sources and thus have different "dim" definitions: Sub nameSheetsFromSheet() Dim vNames() As Variant Dim Cntr As Long Dim wbNew As Worksheet vNames() = Worksheets("Setup").Range("A2:A" & Worksheets("Setup") _ Range("B65536").End(xlUp).Row).Value For Cntr = 1 To UBound(vNames()) Set wbNew = ThisWorkbook.Worksheets.Add wbNew.Name = vNames(Cntr, 1) Set wbNew = Nothing Next Cntr End Sub What I need is a macro that copies a range to a new worksheet AND repeats this step until all of the elements in the list have been copied to new worksheets. I can follow the logic of the first macro and the macro that you sent, but I have no clue on the looping code in the second macro. Could you help me to combine them? Thanks a lot! E. Kohl *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
How? Macro to copy range to new worksheet, name new worksheet, loop
Dick,
Thanks for the quick reply! I'll give it a wirl and let you know. Regards, Edward *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
How? Macro to copy range to new worksheet, name new worksheet, loop
Hello Dick,
Sorry if I'm being an idiot, but when I run the macro that you posted, Excel simply starts an endless loop of creating new worksheets. It gets to about 850 sheets and then I get the Run time error 1004 "Method 'Add' of Object 'Sheets' failed." The debugger points me to this line: 'Create new sheet Set wsh = ThisWorkbook.Worksheets.Add(, _ ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) Any ideas? Thanks in advance. Edward *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
How? Macro to copy range to new worksheet, name new worksheet, loop
Edward
That's my fault. This line Set Rng = Sheet1.Range("a2", Sheet1.Range("A2").End(xlDown)) needs to be changed to this If Sheet1.Range("A65536").End(xlUp).Address = $A$1 Then Set Rng = Sheet1.Range("a2") Else Set Rng = Sheet1.Range("a2", Sheet1.Range("A65536").End(xlUp)) End If I think the problem is that you only have a value in A2 and nothing below it. (Alternatively, you could have values in every cell in column A, but it's not likely.) The loop creates a sheet for every value in column A, except A1. The Range("A2").End(xlDown) statement is like selecting A2 and hitting the End key, then the Down Arrow. If that takes you to the bottom of the sheet (row 65536), then the loop will try to create 65,536 new sheets. You don't have enough memory for that - no one does. So changed it to start at the bottom and go up. This will ensure that if there is only a value in A2 and no other values below it, then only one new sheet will be created. That was just a little sloppiness on my part. Try the new way and let me know if it works. -- Dick Kusleika MVP - Excel www.dicks-clicks.com "E. Kohl" wrote in message ... Hello Dick, Sorry if I'm being an idiot, but when I run the macro that you posted, Excel simply starts an endless loop of creating new worksheets. It gets to about 850 sheets and then I get the Run time error 1004 "Method 'Add' of Object 'Sheets' failed." The debugger points me to this line: 'Create new sheet Set wsh = ThisWorkbook.Worksheets.Add(, _ ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) Any ideas? Thanks in advance. Edward *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
How? Macro to copy range to new worksheet, name new worksheet, loop
Dick,
I replaced the line with the new code but I now get a "Compile Error: Syntax error" and the debugger highlights the first line of the new lines: If Sheet1.Range("A65536").End(xlUp).Address = $A$1 Then Also, when I copied and pasted the new lines into the module window, the font color of the first line automatically changed to red. Regarding your other points, the worksheet contains data from A2 to G17 with the header in A1 to G1. Thanks a lot for the explanation on Range("A2").End(xlDown), etc. I'm slowly starting to get a feel for what the code means. Thanks again, Edward *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
How? Macro to copy range to new worksheet, name new worksheet, loop
Edward
Make sure you change the sheet references to match your situation. I don't know how your sheets are named, but if the sheet with the data is named DATA, then that line will read If Sheets("DATA").Range("A65536").End(xlUp).Address = $A$1 Then -- Dick Kusleika MVP - Excel www.dicks-clicks.com Post all replies to the newsgroup. "E. Kohl" wrote in message ... Dick, I replaced the line with the new code but I now get a "Compile Error: Syntax error" and the debugger highlights the first line of the new lines: If Sheet1.Range("A65536").End(xlUp).Address = $A$1 Then Also, when I copied and pasted the new lines into the module window, the font color of the first line automatically changed to red. Regarding your other points, the worksheet contains data from A2 to G17 with the header in A1 to G1. Thanks a lot for the explanation on Range("A2").End(xlDown), etc. I'm slowly starting to get a feel for what the code means. Thanks again, Edward *** Sent via Developersdex http://www.developersdex.com *** Don't just participate in USENET...get rewarded for it! |
All times are GMT +1. The time now is 06:06 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com