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

按代号复制表并重命名

2 个答案: