Excel 2010 - VBA to Duplicate a worksheet with changing variables

NPetersen

New Member
Joined
Nov 14, 2013
Messages
13
Hello,

This is my first post to MrExcel, so please let me know how to improve my post if it is too detailed/not detailed enough or simply not clear. Thank you in advance for your help.

Contained in worksheet "SSU 1" I have built a table to pull and summarize information from a pivot table contained within the same workbook on another sheet ("PT"). The table looks something like this:
Year 1
Year 2
Year 3
Cost Type 1
*
*
*
Cost Type 2
*
*
*
Cost Type 3
*
*
*

<TBODY>
</TBODY>

Additional notes:
  • Cells identified above in the table with a "*" contain "GetPivotData" formulas with variables that look at the corresponding cost type and year.
  • The Cost Types and Years will remain constant in all tables created by my request below.
  • Also contained on the sheet titled "SSU 1" is a cell containing the worksheet name.
  • I have a sheet called "SSU Listing", containing a list that goes from "SSU 1" to "SSU 15" (This list could change in length; at a later date, I might add an SSU 16).

I am trying to builld a macro to do the following but do not know where to start:
  • I would like to take the sheet "SSU 1" and duplicate it for each SSU contained within the list on the sheet titled "SSU Listing".
  • I would like each new sheet to be renamed for its corresponding SSU. (ie. "SSU 2", "SSU 3", "SSU 4", etc.)
  • Anything in the original sheet which is formula based, I would like it to keep formula based. A few specific formulas I am using within this sheet include:
    • I have cells that are set to display the worksheet name (using a formula built with VBA)
    • I have cells which perform a vlookups on data contained in the "SSU Listing" tab.
    • I have cells containing "GetPivotData" fields based on variable items.
    • I have cells with simple functions such as sums.
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
If I understand correctly, you have a 'template' sheet "SSU 1" you want to copy exactly and rename using a list of sheet names that resides in a sheet named "SSU Listing". What range on the latter sheet is the list in?
 
Upvote 0
Hi JoeMo,

Yes that sounds like a good summary of what I am trying to do. The range of the sheet names is B3:B17.

Thanks,

N
 
Upvote 0
Hi JoeMo,

Yes that sounds like a good summary of what I am trying to do. The range of the sheet names is B3:B17.

Thanks,

N
This assumes that the first sheet on the list is SSU 1 (the template) and already exists. Untested.
Code:
Sub CopyTemplate()
Dim lR As Long, c As Range, i As Long
lR = Sheets("SSU Listing").Range("B" & Rows.Count).End(xlUp).Row
Application.DisplayAlerts = False
For i = 2 To Sheets("SSU Listing").Range("B3:B" & lR).Rows.Count
    On Error Resume Next
    Sheets("SSU " & i).Delete
    On Error GoTo 0
    Sheets("SSU 1").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "SSU " & i
Next i
Application.DisplayAlerts = True
End Sub
 
Upvote 0
I was hoping I could use this code on a second range of sheet names using a new & unique template (sheet "SSU 1.1"). The range of the new list of sheet names is E3:E27 and is on the same sheet "SSU Listing" as the last range. I have changed the code to read:

Code:
Sub CopyTemplate()Dim lR As Long, c As Range, i As Long
lR = Sheets("SSU Listing").Range("E" & Rows.Count).End(xlUp).
RowApplication.DisplayAlerts = False
For i = 2 To Sheets("SSU Listing").Range("E3:E" & lR).Rows.Count
    On Error Resume Next
    Sheets("SSU " & i).Delete
    On Error GoTo 0
    Sheets("SSU 1.1").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "SSU " & i
Next i
Application.DisplayAlerts = True
End Sub



</PRE>

When I run the macro, it creates tabs named: SSU 2, SSU 3, SSU 4, SSU 5, etc. and continues until SSU 25 (ie. the number of cells in the range E3:E27).

I would like it to name the tabs based on the listing I have which does not necessarily have a predictable pattern (ie. "SSU 1.1, SSU 1.2, SSU 2.1, SSU 3.1...etc"). What can I do to correct the code? Thanks!
 
Upvote 0
Assuming the first name on the list is the template sheet ("SSU 1.1"):
Code:
Sub CopyTemplate()
Dim lR As Long, c As Range, i As Long, R As Range
lR = Sheets("SSU Listing").Range("E" & Rows.Count).End(xlUp).Row
Set R = Sheets("SSU Listing").Range("E3:E" & lR)
Application.DisplayAlerts = False
For i = 2 To R.Rows.Count
    On Error Resume Next
    Sheets(R.Cells(i, 1).Value).Delete
    On Error GoTo 0
    Sheets("SSU 1.1").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = R.Cells(i, 1).Value
Next i
Application.DisplayAlerts = True
End Sub
This just refers to the list to name each copied sheet.
 
Upvote 0
Assuming the first name on the list is the template sheet ("SSU 1.1"):
Code:
Sub CopyTemplate()
Dim lR As Long, c As Range, i As Long, R As Range
lR = Sheets("SSU Listing").Range("E" & Rows.Count).End(xlUp).Row
Set R = Sheets("SSU Listing").Range("E3:E" & lR)
Application.DisplayAlerts = False
For i = 2 To R.Rows.Count
    On Error Resume Next
    Sheets(R.Cells(i, 1).Value).Delete
    On Error GoTo 0
    Sheets("SSU 1.1").Copy after:=Sheets(Sheets.Count)
    ActiveSheet.Name = R.Cells(i, 1).Value
Next i
Application.DisplayAlerts = True
End Sub
This just refers to the list to name each copied sheet.


Assumption was correct. That's exactly what I was hoping it would do. Once again this works brilliantly. Thank you.
 
Upvote 0

Forum statistics

Threads
1,216,073
Messages
6,128,638
Members
449,461
Latest member
kokoanutt

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