copy sheet based on list of names once only

[wilg]

Hi there. I have below code to add sheets and name them based on a list of names.
Trying to modify that the new sheet that adds is a duplicate of and existing sheet called "Copy".
I also only want the new tab to be created once only if I was to update the list of names that may add a few or take away a few names.
Any suggestions?



[VBA]Sub ADDSHEETS()
For Each tabname In Sheets("STATUS").Range("A2:A500")
Sheets.Add
ActiveSheet.Name = tabname
Next
End Sub
[/VBA]

[Bob Phillips]

[vba]

Sub ADDSHEETS()
Dim tabname As Range
Dim sh As Worksheet

For Each tabname In Sheets("STATUS").Range("A2:A4")
Sheets.Add
Set sh = Nothing
On Error Resume Next
Set sh = Worksheets(tabname.Value)
On Error GoTo 0
If sh Is Nothing Then

ActiveSheet.Name = tabname.Value
Else

ActiveSheet.Name = tabname & " (Copy)"
End If
Next
End Sub
[/vba]

[Simon Lloyd]

You should declare your variables, try the below:[VBA]Sub ADDSHEETS()
Dim tabname As Range, Sh As Worksheet
For Each tabname In Sheets("Sheet1").Range("A2:A500")
If tabname.Value = vbNullString Then GoTo Nxt
For Each Sh In Sheets
If tabname = Sh.Name Then GoTo Nxt
Next Sh
Sheets.Add
ActiveSheet.Name = tabname.Value
Nxt:
Next
End Sub[/VBA]

[Simon Lloyd]

Hmmmm, just missed your toes - Smart solution!

[wilg]

Hi guys, thanks for the quick responses. I implemented the code, but the sheet I want copied does not copy. just a blank new sheet populates. Names work great. but if I run the code again it populates another set of duplicate sheets with the duplicate names.
Any way of cancelling if already exists and to copy a specified sheet?

[Simon Lloyd]

would you like to post your workbook EXACTLY as you are using the code?, our code checks for the name existing and if it does skip that one and move to the next!

EDIT: Just re-read your response, you didnt ask for a sheet copy you asked to create sheets based off a list of names, thats all the code does, just creates worksheets named as those names.

[Bob Phillips]

I clearly misunderstood

[vba]

Sub ADDSHEETS()
Dim tabname As Range

For Each tabname In Sheets("STATUS").Range("A2:A3")
Worksheets("Copy").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = tabname.Value
Next
End Sub
[/vba]

[wilg]

Here is the workbook. Would like it if I can copy the "Copy" sheet and have the new sheets names from the status ref.
And do not duplicate a sheet if alread exists if I run the code again.

Thanks as always.

[Bob Phillips]

[vba]

Sub ADDSHEETS()
Dim sh As Worksheet
Dim tabname As Range

For Each tabname In Sheets("STATUS").Range("A2:A500")

If tabname.Value <> "" Then

Set sh = Nothing
On Error Resume Next
Set sh = Worksheets(tabname.Value)
On Error GoTo 0
If sh Is Nothing Then

Worksheets("Copy").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = tabname.Value
End If
End If
Next tabname
End Sub
[/vba]

[wilg]

looks like code works good, but it bugs out runtime error 1004 at about 253 worksheets. Is that the max amount of sheets I can make?

[wilg]

Hi there, did anyone have an answer for me re how many sheets are the max excel can copy/ make? I get the error at 253.

[wilg]

Hi XLD, Simon. After researching some more I found this info from Microsoft support.
Apparently if you are copying too many worksheets at one time you need to save and or save and close to continue without getting a runtime 1004 error.
Do you know how I can modify the code you suggested to do this?



[VBA]Sub CopySheetTest()
Dim iTemp As Integer
Dim oBook As Workbook
Dim iCounter As Integer

' Create a new blank workbook:
iTemp = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set oBook = Application.Workbooks.Add
Application.SheetsInNewWorkbook = iTemp

' Add a defined name to the workbook
' that RefersTo a range:
oBook.Names.Add Name:="tempRange", _
RefersTo:="=Sheet1!$A$1"

' Save the workbook:
oBook.SaveAs "c:\test2.xls"

' Copy the sheet in a loop. Eventually,
' you get error 1004: Copy Method of
' Worksheet class failed.
For iCounter = 1 To 275
oBook.Worksheets(1).Copy After:=oBook.Worksheets(1)
'Uncomment this code for the workaround:
'Save, close, and reopen after every 100 iterations:
If iCounter Mod 100 = 0 Then
oBook.Close SaveChanges:=True
Set oBook = Nothing
Set oBook = Application.Workbooks.Open("c:\test2.xls")
End If
Next
End Sub
[/VBA]