Macro to create multiple sheets from master sheet

Cristinky420

New Member
Joined
Feb 13, 2019
Messages
17
Newbie here! First time posting but I've used your forum for many years!

Please be patient as I am not very well versed in code writing.

I have the following:

Master:
  • Cells (a2:a201) are Client # (0001-0200)
  • Cells (b2:b201) are Status ("active" & "inactive")
  • Cells (c2:c201) are Names (Last, First)

Blank Client:
  • A1 = Client #
  • B1 = Name
  • G1 = Status

I would like to make Client # sheets (worksheets named 0001, 0002, 0003, 0004, etc.)

We will input new data into the Master Sheet.

The "0001" Client Sheet will then auto populate the A1, B1 & G1 fields. i.e. - If Worksheet Name = 0001, then A1=Master!A2, B1=Master!C2, G1=Master!B2

I would like to also create a hyperlink to click from the Master Sheet Client # (Master!A2) and have that redirect to the appropriate client sheet (0001!)

A macro might be best... let me know your thoughts!

Thanks for your help!
 

Some videos you may like

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
You are welcome
Run this macro.


If you create new clients, run the macro and create only the new client sheets.

Code:
Sub Create_Multiple_Sheets()
    Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
    Dim i As Long, u1 As Long
    Dim wClie As String, wStat As String, wName As String
    Dim existe As Boolean
    
    Application.ScreenUpdating = False
    
    Set sh1 = Sheets("Master")
    u1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 2 To u1
        wClie = sh1.Cells(i, "A").Value
        wStat = sh1.Cells(i, "B").Value
        wName = sh1.Cells(i, "C").Value
        existe = False
        For Each sh2 In Sheets
            If sh2.Name = wClie Then
                existe = True
                Exit For
            End If
        Next
        If existe = False Then
            'Create sheet
            Set sh3 = Sheets.Add(after:=Sheets(Sheets.Count))
            sh3.Name = wClie
            sh3.Range("A1").Value = wClie
            sh3.Range("B1").Value = wName
            sh3.Range("G1").Value = wStat
            
            'Create Hyperlink
            sh1.Hyperlinks.Add Anchor:=sh1.Cells(i, "A"), Address:="", _
                SubAddress:=sh3.Name & "!A1", TextToDisplay:=sh1.Cells(i, "A").Value
        End If
    Next
    sh1.Select
    
    Application.ScreenUpdating = True
    
    MsgBox "End"
    
End Sub
 

Cristinky420

New Member
Joined
Feb 13, 2019
Messages
17
OMG this is so close to what I need... I can sense it! I will one day learn this vba code writing talent!

The hyperlink part isn't working. It creates the first page and stops with an Error 5. When I removed the hyperlink part of the code it produced all 200 pages for me. I believe this error happened because my client # is displayed as 4 digits in the master sheet, but the sheets created were single digits. (1, 2, 3...)

Can the new sheet created reflect all 4 digits?

Instead of Create a New sheet, can it copy "Blank Client" sheet and insert the same information into it?

ie:

0001!A1=Master!A2
0001!B1=Master!C2
0001!G1=Master!B2

"Blank Client" being my template for the rest of the client pages

Thank-you thank-you!
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
Try with this:

Code:
Sub Create_Multiple_Sheets()
    Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet
    Dim i As Long, u1 As Long
    Dim wClie As String, wStat As String, wName As String
    Dim existe As Boolean
    
    Application.ScreenUpdating = False
    
    Set sh1 = Sheets("Master")
    Set sh4 = Sheets("Blank Client")
    u1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 2 To u1
        wClie = sh1.Cells(i, "A").Value
        wStat = sh1.Cells(i, "B").Value
        wName = sh1.Cells(i, "C").Value
        existe = False
        For Each sh2 In Sheets
            If sh2.Name = wClie Then
                existe = True
                Exit For
            End If
        Next
        If existe = False Then
            'Create sheet
            'Set sh3 = Sheets.Add(after:=Sheets(Sheets.Count))
            sh4.Copy after:=Sheets(Sheets.Count)
            Set sh3 = ActiveSheet
            sh3.Name = Format(wClie, "0000")
            sh3.Range("A1").Value = "'" & Format(wClie, "0000")
            sh3.Range("B1").Value = wName
            sh3.Range("G1").Value = wStat
            
            'Create Hyperlink
            sh1.Hyperlinks.Add Anchor:=sh1.Cells(i, "A"), Address:="", _
                SubAddress:=sh3.Name & "!A1", TextToDisplay:=sh1.Cells(i, "A").Value
        End If
    Next
    sh1.Select
    
    Application.ScreenUpdating = True
    
    MsgBox "End"
    
End Sub
 

Cristinky420

New Member
Joined
Feb 13, 2019
Messages
17

ADVERTISEMENT

Hey there Dante

Once again, the hyperlink creation did not work :(

I removed the hyperlink part of the code and it generated all the pages exactly as I hoped!

Also, when I added Client #0201 and ran it again I received an error that said the name was already taken? and it created "Blank Client (2)"

Maybe a seperate hyperlink macro would work?

If Master!A:A=SheetName create a hyperlink in appropriate Master cell and hide the corresponding sheet, when I click the hyperlink it opens the sheet up, and when i click on a "Master" hyperlink it returns me to the master page and closes the hyperlink?
 

Cristinky420

New Member
Joined
Feb 13, 2019
Messages
17
When entering Client #201 and running the code the following line comes up as error 1004:

sh3.Name = Format(wClie, "0000")
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

If you have problems with the hyperlink, tell me the error message. Then activate the macro recorder, create a hyperlink of the first text to the sheet "0001", stop the recorder, put the resulting code here.

If you have problems with any sheet, you must tell me exactly what you have in the cell: 201 or 0201 or '201 or '0201 or 201 with cell format "0000".


Try again:

Code:
Sub Create_Multiple_Sheets()
    Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, sh4 As Worksheet
    Dim i As Long, u1 As Long
    Dim wClie As String, wStat As String, wName As String
    Dim existe As Boolean
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set sh1 = Sheets("Master")
    Set sh4 = Sheets("Blank Client")
    u1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 2 To u1
        wClie = sh1.Cells(i, "A").Value
        wClie = Format(Val(WorksheetFunction.Trim(wClie)), "0000")
        wStat = sh1.Cells(i, "B").Value
        wName = sh1.Cells(i, "C").Value
        existe = False
        For Each sh2 In Sheets
            
            If sh2.Name = wClie Then
                existe = True
                Exit For
            End If
        Next
        If existe = False Then
            'Create sheet
            sh4.Copy after:=Sheets(Sheets.Count)
            Set sh3 = ActiveSheet
            
            sh3.Name = wClie
            sh3.Range("A1").Value = "'" & wClie
            sh3.Range("B1").Value = wName
            sh3.Range("G1").Value = wStat
            
            'Create Hyperlink
            sh1.Hyperlinks.Add Anchor:=sh1.Cells(i, "A"), Address:="", _
                SubAddress:="'" & wClie & "'!A1"


        End If
    Next
    sh1.Select
    
    Application.ScreenUpdating = True
    
    MsgBox "End"
    
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,694
Messages
5,597,571
Members
414,156
Latest member
WDMix

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