Unhide sheet, copy and rename new sheets from list, rehide sheet
 

I thank Garry of this forum for this code which I want to make into a generic scheme of:

Unhide the sheet named "CopyMe"
Make a copy/s and name it using the name/s in Sheets("Sheet1").Range("MyNewList")
Rehide "CopyMe"

What it does after my small alterations is copy a sheet for each name in MyNewList, properly name them from that list, then produce an additional two sheets named CopyMe(2) and CopyMe(3), then errors our on this line of ErrHandler: ActiveSheet.Name = vNames.

If there are no names in the "MtNewList" then it produces CopyMe(2) and CopyMe(3) and errors out on the same line as noted above.

The code is in a standard module and "MyNewList" is Workbook in scope.

Thanks.
Howard

Option Explicit
Option Base 1

Type udtAppModes
Events As Boolean: CalcMode As Long: Display As Boolean: RunFast As Boolean
End Type
Public AppMode As udtAppModes

Sub CopySheetAndNameCopies()
'** COLUMN A SHEET NAMES LIST CANNOT HAVE GAPS ***
Dim vNames, n&

On Error Resume Next '//handles empty list
vNames = Sheets("Sheet1").Range("MyNewList")
If Not IsArray(vNames) Then
If vNames = "" Then Beep: Exit Sub
End If 'Not IsArray
On Error GoTo ErrHandler '//handles only 1 sheetname

EnableFastCode
Sheets("CopyMe").Visible = True

For n = LBound(vNames) To UBound(vNames)
If Not bSheetExists(vNames(n, 1)) Then
Sheets("CopyMe").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = vNames(n, 1)
End If 'Not bSheetExists
Next 'n

NormalExit:
Sheets("CopyMe").Visible = False: Sheets("Sheet1").Select
EnableFastCode False: Exit Sub

ErrHandler:
If Not bSheetExists(vNames) Then
Sheets("CopyMe").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = vNames
End If 'Not bSheetExists
Resume NormalExit
End Sub 'CopySheetAndNameCopies
Function bSheetExists(WksName) As Boolean
On Error Resume Next
bSheetExists = CBool(Len(ActiveWorkbook.Sheets(WksName).Name))
End Function
Public Sub EnableFastCode(Optional SetFast As Boolean = True)
'Make sure we're not already enabled/disabled elsewhere
If AppMode.RunFast = SetFast Then Exit Sub
With Application
If SetFast Then
AppMode.Display = .ScreenUpdating: .ScreenUpdating = False
AppMode.CalcMode = .Calculation: .Calculation = xlCalculationManual
AppMode.Events = .EnableEvents: .EnableEvents = False
AppMode.RunFast = True
Else
.ScreenUpdating = AppMode.Display: .Calculation = AppMode.CalcMode
.EnableEvents = AppMode.Events: AppMode.RunFast = False
End If
End With
End Sub

Unhide sheet, copy and rename new sheets from list, rehide sheet
 

Hi Howard,

Am Sat, 12 Oct 2013 03:59:00 -0700 (PDT) schrieb Howard:

Unhide the sheet named "CopyMe"
Make a copy/s and name it using the name/s in Sheets("Sheet1").Range("MyNewList")
Rehide "CopyMe"

try in a standard module:

Function SheetExists(strShName As String) As Boolean
On Error Resume Next
SheetExists = Not Sheets(strShName) Is Nothing
End Function

Sub CopyMe()
Dim rngC As Range
Application.ScreenUpdating = False
With Sheets("CopyMe")
.Visible = True
For Each rngC In .Range("MyNewList")
If Not SheetExists(rngC.Value) Then
.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = rngC
End If
Next
.Visible = False
End With
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Unhide sheet, copy and rename new sheets from list, rehide sheet
 

Hallo Howard,

Am Sat, 12 Oct 2013 13:29:41 +0200 schrieb Claus Busch:

For Each rngC In .Range("MyNewList")

Change to:
For Each rngC In Sheets("Sheet1").Range("MyNewList")


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Unhide sheet, copy and rename new sheets from list, rehide sheet
 

On Saturday, October 12, 2013 4:44:17 AM UTC-7, Claus Busch wrote:
Hallo Howard,



Am Sat, 12 Oct 2013 13:29:41 +0200 schrieb Claus Busch:



For Each rngC In .Range("MyNewList")



Change to:

For Each rngC In Sheets("Sheet1").Range("MyNewList")

Regards


I'm getting sheets named as they should be PLUS a CopyMe(2) and then an error on line:

ActiveSheet.Name = rngC

I also changed MyNewList to sheet 1 scope. As workbook scope I believe I was getting only a CopyMe(2) then the error.

Howard

Unhide sheet, copy and rename new sheets from list, rehide sheet
 

Hi Howard,

Am Sat, 12 Oct 2013 05:00:41 -0700 (PDT) schrieb Howard:

I'm getting sheets named as they should be PLUS a CopyMe(2) and then an error on line:

do you have an empty cell in MyNewList?


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Unhide sheet, copy and rename new sheets from list, rehide sheet
 

On Saturday, October 12, 2013 5:03:51 AM UTC-7, Claus Busch wrote:
Hi Howard,



Am Sat, 12 Oct 2013 05:00:41 -0700 (PDT) schrieb Howard:



I'm getting sheets named as they should be PLUS a CopyMe(2) and then an error on line:



do you have an empty cell in MyNewList?





Regards

Claus B.

Yes, the range of MyNewList is A1:A10, and I have just been doing a couple names in testing.

I tried to reset the range to this but the Define Name Box would not take it.
Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)

Howard

Unhide sheet, copy and rename new sheets from list, rehide sheet
 

Hi Howard,

Am Sat, 12 Oct 2013 05:22:23 -0700 (PDT) schrieb Howard:

I tried to reset the range to this but the Define Name Box would not take it.
Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)

try:
=OFFSET(Sheet1!$A$1,,,COUNTA(Sheet1!$A:$A))
for MyNewList


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Unhide sheet, copy and rename new sheets from list, rehide sheet
 

On Saturday, October 12, 2013 5:35:51 AM UTC-7, Claus Busch wrote:
Hi Howard,



Am Sat, 12 Oct 2013 05:22:23 -0700 (PDT) schrieb Howard:



I tried to reset the range to this but the Define Name Box would not take it.

Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)



try:

=OFFSET(Sheet1!$A$1,,,COUNTA(Sheet1!$A:$A))

for MyNewList





Regards

Claus B.


It errors out on this line.

For Each rngC In Sheets("Sheet1").Range("MyNewList")

This does go in the refers to: of the define name box, right?
=OFFSET(Sheet1!$A$1,,,COUNTA(Sheet1!$A:$A))


Howard

Unhide sheet, copy and rename new sheets from list, rehide sheet
 

Hi Howard,

Am Sat, 12 Oct 2013 05:48:56 -0700 (PDT) schrieb Howard:

For Each rngC In Sheets("Sheet1").Range("MyNewList")

for a range name (workbook)

Sub CopyMe()
Dim rngC As Range
Application.ScreenUpdating = False
ActiveWorkbook.Names.Add "MyNewList", _
RefersTo:="=Offset(Sheet1!$A$1,,,CountA(Sheet1!$A: $A))"
With Sheets("CopyMe")
.Visible = True
For Each rngC In Range("MyNewList")
If Not SheetExists(rngC.Value) Then
.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = rngC
End If
Next
.Visible = False
End With
Application.ScreenUpdating = True
End Sub

If you have a range name (workbook scope)
and not all cells are filled try:
Sub CopyMe2()
Dim rngC As Range
Application.ScreenUpdating = False
With Sheets("CopyMe")
.Visible = True
For Each rngC In Range("MyNewList")
If Len(rngC) 0 Then
If Not SheetExists(rngC.Value) Then
.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = rngC
End If
End If
Next
.Visible = False
End With
Application.ScreenUpdating = True
End Sub

Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2

Unhide sheet, copy and rename new sheets from list, rehide sheet
 

All is well! Thank you, Claus.

Regards,
Howard