コピーコードネームによる用紙と私はそのコード名でシートをコピーし、コピーしたシートは、名前とコード名を表示する名前を変更しようとしている

Question

名前の変更は、

私はこれを作ってみたが、それは一つだけの時間を仕事とその表示名とコードネームを持つシートがすでに存在するため、エラーが発生します。名前の末尾に値+1を追加できるのはなぜですか？

Sub TESTONE() 


Dim MySheetName As String 
MySheetName = "Rename Me" 
VBA_Copy_Sheet.Copy After:=ActiveSheet 
ActiveSheet.Name = MySheetName 

ActiveSheet.Tab.ColorIndex = 3 

Dim wks As Worksheet 
Set wks = ActiveSheet 
ThisWorkbook.VBProject.VBComponents(wks.CodeName).Name = "BidSheet" 


End Sub 

Answer 1

私はそれはつまり、あなたが範囲名にカウンターを保存し、あなたのシートをインクリメントすることを使用することができ、あなたに

Sub TESTONE() 

Dim MySheetName As String 
Dim MyCodeName As String 
Dim wks As Worksheet 

MySheetName = "Rename Me" 
MyCodeName = "BidSheet" 

If VBA_Copy_Sheet = Empty Then 
Set VBA_Copy_Sheet = ActiveSheet 
End If 

VBA_Copy_Sheet.Copy After:=ActiveSheet 

ActiveSheet.Name = GetNewSheetName(MySheetName, 0) 

ActiveSheet.Tab.ColorIndex = 3 
Set wks = ActiveSheet 
MyCodeName = GetNewCodeName(MyCodeName, 0) 

ThisWorkbook.VBProject.VBComponents(wks.CodeName).Name = MyCodeName 

End Sub 

Function GetNewSheetName(ByVal newName As String, ByVal n As Integer) As String 

    Dim ws As Worksheet 
    Dim modifiedName As String 
    modifiedName = newName & n 

    For Each ws In ActiveWorkbook.Worksheets 
     If ws.Name = modifiedName Then 
      n = n + 1 
      modifiedName = GetNewSheetName(newName, n) 
      Exit For 
     End If 
    Next 
    GetNewSheetName = modifiedName 
End Function 

Function GetNewCodeName(ByVal newName As String, ByVal n As Integer) As String 

    Dim ws As Worksheet 
    Dim modifiedName As String 
    modifiedName = newName & n 

    For Each ws In ActiveWorkbook.Worksheets 
     If ws.CodeName = modifiedName Then 
      n = n + 1 
      modifiedName = GetNewCodeName(newName, n) 
      Exit For 
     End If 
    Next 
    GetNewCodeName = modifiedName 
End Function 

Answer 2

を助け、希望：

Dim strName As String 
Dim strCnt As String 
Dim MySheetName As String 

strName = "SheetCnt" 

On Error Resume Next 
strCnt = ActiveWorkbook.Names(strName).Value 
On Error GoTo 0 
If Len(strCnt) = 0 Then 
    ActiveWorkbook.Names.Add strName, 1 
Else 
    strCnt = Replace(strCnt, "=", Chr(32)) + 1 
    ActiveWorkbook.Names(strName).RefersTo = strCnt 
End If 

MySheetName = "Rename Me " & strCnt