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!
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
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
 
Upvote 0
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!
 
Upvote 0
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
 
Upvote 0
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?
 
Upvote 0
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
 
Upvote 0
I'm glad to help you. Thanks for the feedback.
 
Upvote 0
I'm completely stuck and my brain hurts. I am trying to get my workbook to build worksheets off of a master sheet and follow a sequence number off of a table. The table has pertinent data that needs to load in several locations on the sheet. I've built all of the buttons on the cover page and have some of the coding done but I'm not smart enough to write it. This has been a trial and error-thing since the beginning. I used to have friends to ask for help with this but we have lost touch.
 

Attachments

  • Forum Help.png
    Forum Help.png
    45.7 KB · Views: 8
  • Screenshot 2023-08-15 152844.png
    Screenshot 2023-08-15 152844.png
    89.1 KB · Views: 8
  • Screenshot 2023-08-15 152939.png
    Screenshot 2023-08-15 152939.png
    22.1 KB · Views: 8
Upvote 0

Forum statistics

Threads
1,217,357
Messages
6,136,081
Members
449,990
Latest member
orthodmd

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