如何通过InputBox为复制的两张工作表命名带固定后缀的名称？

你的核心需求是通过InputBox获取统一前缀，为复制后的两张工作表分别添加指定后缀，同时确保新表名不重复。我会基于你的现有代码进行修改，解决如何引用新复制工作表的问题：

关键改进点 #

• 复制工作表后立即获取新表的引用：因为你是将工作表复制到工作簿末尾，新生成的两张表就是工作簿的最后两张，我们可以直接通过索引获取它们的对象引用，存入数组方便后续操作。
• 验证两个新表名是否都不存在：避免出现其中一个表名已被使用的情况。
• 用InputBox的前缀结合固定后缀，批量设置新表的名称。

修改后的完整代码 #

Public Sub CopySheets()
    Dim prefix As String ' 存储用户输入的前缀
    Dim newSheetNames(1 To 2) As String ' 存储两个新表的完整名称
    Dim newSheets(1 To 2) As Worksheet ' 存储新复制的工作表对象
    Dim namesExist As Boolean
    
    Do
        prefix = InputBox("Please enter name of new project", "New Project")
        If prefix <> "" Then
            ' 生成两个新表的完整名称
            newSheetNames(1) = prefix & " - Project"
            newSheetNames(2) = prefix & " - Report"
            
            ' 检查两个新表名是否都不存在
            namesExist = SheetExists(newSheetNames(1)) Or SheetExists(newSheetNames(2))
            
            If Not namesExist Then
                ' 复制指定工作表到工作簿末尾
                Worksheets(Array(1, 2)).Copy After:=Sheets(Sheets.Count)
                
                ' 获取新复制的两张工作表对象（注意顺序：原数组第一个表的副本是倒数第二张，第二个是最后一张）
                Set newSheets(1) = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count - 1)
                Set newSheets(2) = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                
                ' 为新表设置名称
                newSheets(1).Name = newSheetNames(1)
                newSheets(2).Name = newSheetNames(2)
                
                MsgBox "Sheets created successfully:" & vbCrLf & newSheetNames(1) & vbCrLf & newSheetNames(2), vbOKOnly + vbInformation, "Success"
                Exit Do ' 完成操作后退出循环
            Else
                MsgBox "One or both sheet names already exist:" & vbCrLf & newSheetNames(1) & vbCrLf & newSheetNames(2), vbOKOnly + vbCritical, "Error"
            End If
        Else
            ' 用户取消输入，退出循环
            Exit Do
        End If
    Loop Until Not namesExist Or prefix = ""
End Sub

Private Function SheetExists(ByVal sheetName As String, Optional ByVal wb As Workbook) As Boolean
    If wb Is Nothing Then Set wb = ActiveWorkbook
    On Error Resume Next
    SheetExists = Not wb.Worksheets(sheetName) Is Nothing
    On Error GoTo 0 ' 恢复错误处理
End Function

代码说明 #

1. 获取新表引用：复制完成后，ThisWorkbook.Sheets.Count - 1指向第一张新复制的表，ThisWorkbook.Sheets.Count指向第二张，我们把它们存入newSheets数组，后续就可以通过这个数组直接操作这两张表。
2. 表名验证：先根据前缀生成完整的两个表名，再调用SheetExists函数检查是否存在任何一个重复的表名，避免创建失败。
3. 命名逻辑：直接通过数组中的工作表对象设置Name属性，完成前缀+后缀的命名。

这样就完美实现了你的需求：通过InputBox指定前缀，自动为两张新表添加对应后缀，同时正确引用并操作这两张工作表。

内容的提问来源于stack exchange，提问作者Kaizan