Copy template worksheet and rename it only if name already is not taken

Utk_Gpt

New Member
Joined
Sep 6, 2021
Messages
9
Office Version
  1. 2019
Platform
  1. Windows
Hi All,
I am trying to find a macro that can copy a template worksheet multiple times and rename the worksheet based on a list in another worksheet starting from cell B6.
"Template" is the name of the sheet to be copied
"Client List" is the name of the worksheet in which the list is with some other information but I need to rename them according to the cell B6 and down.

I found a code in one of the threads relevant to this:
VBA Code:
Sub makeSheets()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Client List")
    For Each c In sh2.Range("B5", sh2.Cells(Rows.Count, 2).End(xlUp))
        sh1.Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = c.Value
    Next

Issue in the above code: I have to regularly update the "Client List" time to time thus require to re-run the macro. If I re-run the above code, it shows Error 1004 (Name is already taken) and creates a copy of "Template" with the name "Template (2)" at the end.

Modification required: If a sheet with the name is already created (as the macro was run earlier), the macro should continue to run and copy the "Template" sheet and rename it to the remaning values in the "Client List" till the list is not over. It should not affect the already created copies.

Please Help. Thank You!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,850
Office Version
  1. 365
Platform
  1. Windows
Ok, I was going by your code & missed the fact that the first name is in B6 not B5, try
VBA Code:
Sub makeSheets()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
Set sh1 = Sheets("sheet1")
Set sh2 = Sheets("Lists")
    For Each c In sh2.Range("B6", sh2.Cells(Rows.Count, 2).End(xlUp))
        If Not Evaluate("isref('" & c.Value & "'!A1)") Then
            sh1.Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = c.Value
        End If
    Next
End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

Utk_Gpt

New Member
Joined
Sep 6, 2021
Messages
9
Office Version
  1. 2019
Platform
  1. Windows
VBA Code:
Sub AddClientSheet()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Client List")
    For Each c In sh2.Range("B6", sh2.Cells(Rows.Count, 2).End(xlUp))
        If Not Evaluate("isref('" & c.Value & "'!A1)") Then
            sh1.Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = c.Value
        End If
    Next
End Sub

I am using this code and the error is same: Run-time Error '13'

Kindly help
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,850
Office Version
  1. 365
Platform
  1. Windows
If you add the message box as shown, what does it return?
VBA Code:
Set sh2 = Sheets("Client List")
MsgBox sh2.Cells(Rows.Count, 2).End(xlUp).Row
    For Each c In sh2.Range("B6", sh2.Cells(Rows.Count, 2).End(xlUp))
 

Utk_Gpt

New Member
Joined
Sep 6, 2021
Messages
9
Office Version
  1. 2019
Platform
  1. Windows
Thank you so much for your constant efforts to resolve the issue.

It gave a message box "105". What I can understand, till 105 cell I have applied a formula to retrieve client list from another sheet. From 106 cell, there is no formula applied. According to the formula, if client name is not there on the Main sheet it will give "" on Client List. Please refer to the screenshot attached and let me know how it can be resolved.
 

Attachments

  • Screenshot (146).png
    Screenshot (146).png
    228.1 KB · Views: 3

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,850
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

In that case you have "blank" cells in the range which is the problem.Try
VBA Code:
Sub makeSheets()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Client List")
    For Each c In sh2.Range("B6", sh2.Cells(Rows.Count, 2).End(xlUp))
        If c.Value <> "" Then
            If Not Evaluate("isref('" & c.Value & "'!A1)") Then
                sh1.Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = c.Value
            End If
         End If
    Next
End Sub
 
Solution

Utk_Gpt

New Member
Joined
Sep 6, 2021
Messages
9
Office Version
  1. 2019
Platform
  1. Windows
In that case you have "blank" cells in the range which is the problem.Try
VBA Code:
Sub makeSheets()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
Set sh1 = Sheets("Template")
Set sh2 = Sheets("Client List")
    For Each c In sh2.Range("B6", sh2.Cells(Rows.Count, 2).End(xlUp))
        If c.Value <> "" Then
            If Not Evaluate("isref('" & c.Value & "'!A1)") Then
                sh1.Copy After:=Sheets(Sheets.Count)
                ActiveSheet.Name = c.Value
            End If
         End If
    Next
End Sub
Thank you so much Fluff!

The error is completely resolved now.
Just wish to know, how to add a message box saying "All clients are added" once all the client sheets in the list are added.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,850
Office Version
  1. 365
Platform
  1. Windows
Just add this before the end sub line
VBA Code:
MsgBox "All clients are added"
 

Forum statistics

Threads
1,147,962
Messages
5,744,057
Members
423,843
Latest member
alex2022

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