View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Howard Howard is offline
external usenet poster
 
Posts: 536
Default 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