Macro to copy a worksheet and name the sheet 1 more than highest valued worksheet name in book

JSlabach

New Member
Joined
Feb 14, 2009
Messages
19
I have a workbook with one worksheet named 0 which will serve as a template and a worksheet named data.
I need help with a macro to copy sheet 0, a command button for this macro would be placed in sheet data.
Every time the macro button is pushed it would create an additional copy of sheet 0 in the same workbook,
each new sheet being automatically named one consecutive number higher than the highest numbered worksheet name currently in the book also putting that sheet name/number in cell h3 of each new sheet.
So I could push this button 100 times and end up with 100 copies of sheet 0, with the sheet names being numbered 1 through 100 and having the sheet name in each sheet's cell h3.
 

Some videos you may like

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,384
Code:
[COLOR=darkblue]Sub[/COLOR] Duplicate_Template_0()
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    Sheets("0").Copy After:=Sheets(Sheets.Count)
    [COLOR=darkblue]With[/COLOR] ActiveSheet
        .Name = Sheets.Count - 2
        .Range("H3").Value = .Name
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    Sheets("Data").Select
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 

JSlabach

New Member
Joined
Feb 14, 2009
Messages
19
Thank you.
That seems way too simple.
I was definitely going about it the wrong way.
Just wondering what the part about application screen updating is for.
I've never seen that.
 

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649
Jslabach,

Here is sheet 0, with range E2:F4 simulating the command button to run the macro:


Excel Workbook
ABCDEFGH
1
2Copy this Sheet
30
4
5Macro to copy a worksheet
6and name the sheet 1 more than
7highest valued worksheet name in book
8
0




If you were to run the macro five times, you would have sheets 0, 1, 2, 3, 4, and 5:


Excel Workbook
ABCDEFGHI
1
2
35
4
5Macro to copy a worksheet
6and name the sheet 1 more than
7highest valued worksheet name in book
8
5





If you were to delete say sheet 4, and then run the macro again (press the command button again), the next sheet that you would get would be sheet 6:


Excel Workbook
ABCDEFGHI
1
2
36
4
5Macro to copy a worksheet
6and name the sheet 1 more than
7highest valued worksheet name in book
8
6





Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Select the worksheet in which your code is to run, sheet 0
3. Right click on the sheet tab and choose View Code, to open the Visual Basic Editor

4. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
4. a. If your command button is CommandButton1, then copy the code here.

5. Press the keys ALT + Q to exit the Editor, and return to Excel


Code:
Option Explicit
Private Sub CommandButton1_Click()
' hiker95, 06/18/2012
' http://www.mrexcel.com/forum/showthread.php?641432-Macro-to-copy-a-worksheet-and-name-the-sheet-1-more-than-highest-valued-worksheet-name-in-book
' Macro to copy a worksheet and name the sheet 1 more than highest valued worksheet name in book.
Dim w0 As Worksheet, ws As Worksheet
Dim wsc As Long, wsm As Long
Dim lur As Long, luc As Long
Application.ScreenUpdating = False
Set w0 = Worksheets("0")
lur = w0.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
luc = w0.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
wsc = ThisWorkbook.Worksheets.Count
wsm = 0
If wsc = 1 Then
  Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = CLng(wsm) + 1
  Set ws = ActiveSheet
  w0.Range(w0.Cells(1, 1), w0.Cells(lur, luc)).Copy ws.Cells(1, 1)
  ws.Cells(3, 8).Value = CLng(wsm) + 1
Else
  For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "0" Then
      If CLng(ws.Name) > wsm Then wsm = CLng(ws.Name)
    End If
  Next ws
  Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = CLng(wsm) + 1
  Set ws = ActiveSheet
  w0.Range(w0.Cells(1, 1), w0.Cells(lur, luc)).Copy ws.Cells(1, 1)
  ws.Cells(3, 8).Value = CLng(wsm) + 1
End If
w0.Activate
Application.ScreenUpdating = True
End Sub


Then click on the CommandButton1_Click button/macro again.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,333
Messages
5,601,008
Members
414,421
Latest member
tonybear1994

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
Top