VBA code to Duplicate and Rename sheets according to a list

magemaester

New Member
Joined
Dec 17, 2017
Messages
10
Hi guys,

I want to duplicate a worksheet 10 times, and rename those 10 sheets according to a table of names residing in another spreadsheet. Currently I've written the following code:

Dim iSheetNumber As Long
Dim rNewSheetNames As Range
Dim rName As Range

Set rNewSheetNames = Sheets("SheetNameTable").Range("E7:E16")

For iSheetNumber = 1 To 10
ActiveSheet.Copy After:=Sheets(Sheets.Count)
For Each rName In rNewSheetNames

ActiveSheet.Name = rName.Value
Next rName
Next iSheetNumber


I believe the error in this macro is that I've used nested For-Next statements, so the macro gets stuck inside the inner For Each-Next loop and doesn't really duplicate the sheets. Instead it just keeps trying to rename the same sheet over and over again. I'm a beginner VBA user and I couldn't figure out how to work around it. Can anyone help?

Thanks once again!
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
First off, you are identifying the problem correctly. Your VBA code wants to create 10 copies of the sheet, but the nested For ... Next renames the first copy 10 times and ends up on the name found in the last cell of the source range. Presumably the VBA proceeds to create a second copy, renames it 10 times, and ends up with a name that is already in use. You didn't mention it, but I am assuming that is the point where you see an error message.

There are various ways to resolve this. Here is a solution where you start by reading the 10 sheet names into an array, and then apply them one by one as each new sheet is created:

Code:
    Dim SourceSheet As Worksheet
    Dim i As Long, RowNumber As Long
    Dim rName As Range
    Dim SheetName(9)
    
    Set SourceSheet = ActiveSheet
    
    For i = 0 To 9
        RowNumber = i + 7
        SheetName(i) = ThisWorkbook.Sheets("SheetNameTable").Range("E" & RowNumber).Value
    Next
    
    For i = 0 To 9
        SourceSheet.Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = SheetName(i)
    Next i

I changed your iSheetNumber to i because it is a little easier on the eye, but that is just a stylistic preference; you can apply whatever names you prefer.

By default a VBA array is base 0, meaning that the array elements here are numbered 0-9. First we read the 10 sheet names into the SheetName array, then in a separate For ... Next loop we generate and name the 10 child sheets.

Also note that ActiveSheet changes; each time you generate a copy the new sheet becomes the active sheet. In this case all sheets are identical, so you will arrive at the same result either way, but it is good coding practice to nail down your source sheet at the outset. In future projects you can encounter a lot of errors just from making assumptions about which sheet is active at any given point during code execution.

Hope this helps, and good luck with VBA!
 
Upvote 0
Hi Bdra,

I get the logic of your code, but this line returns a "Subscript out of range" error:

SheetName(i) = ThisWorkbook.Sheets("SheetNameTable").Range("E" & RowNumber).Value)

Can you fix? I googled the error and it says usually its because the subscript is out of the range of the array you defined. But your code has declared it as 0-9 so I don't know why its returning this error?
 
Upvote 0
This is a shorter version. see if it will work for you.

Code:
Sub t()
Dim i As Long, SourceSheet As Worksheet
Set SourceSheet = ActiveSheet
    For i = 7 To 16
        SourceSheet.Copy After:=Sheets(Sheets.Count)
        On Error Resume Next
        ActiveSheet.Name = Sheets("SheetNameTable").Range("E" & i).Value
        On Error GoTo 0
    Next
End Sub
 
Last edited:
Upvote 0
JLGWhiz has offered a neater and more economical approach that dispenses with the array; you may want to follow his suggestion instead.

But let me add a quick response anyway, in the interest of learning from the "Subscript out of range" error. I tested my suggestion on my own system before posting it, so there shouldn't be any error if you simply copy-and-pasted it. But there is more than one subscript in the line you indicate, which means there is more than one possible culprit to look at:

Code:
SheetName(i) = ThisWorkbook.Sheets("SheetNameTable").Range("E" & RowNumber).Value)

If you didn't change the dimensioning of the array or the number of cell values you read into it, could it be that there is simply no sheet named "SheetNameTable" in the workbook where you pasted the code?
 
Upvote 0

Forum statistics

Threads
1,223,640
Messages
6,173,503
Members
452,517
Latest member
SoerenB

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top