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

[Howard]

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

 

[Claus Busch]

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.

 

[Claus Busch]

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.

 

[Howard]

Hallo Howard,



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






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

 

[Claus Busch]

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.

 

[Howard]

Hi Howard,



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






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

 

[Claus Busch]

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.

 

[Howard]

Hi Howard,



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







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

 

[Howard]

All is well! Thank you, Claus.

Regards,
Howard