创建新副本VBA

nnsea

Sub CopyAndRenameWorksheetWithInput()
    ' 定义源工作表名称和目标工作表名称
    Dim sourceSheetName As String
    Dim targetSheetName As String
      
    sourceSheetName = "Sheet1" ' 源工作表名称，假设我们要复制这个工作表
      
    ' 弹出输入框让用户填写目标工作表的新名称
    targetSheetName = InputBox("请输入目标工作表的新名称：", "重命名工作表")
      
    ' 检查用户是否输入了名称
    If targetSheetName = "" Then
        MsgBox "您没有输入新工作表的名称，操作已取消。", vbExclamation
        Exit Sub
    End If
      
    ' 检查源工作表是否存在以及目标工作表名是否已存在
    On Error Resume Next ' 忽略错误
    Dim sourceSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Sheets(sourceSheetName)
    Dim targetSheet As Worksheet
    Set targetSheet = ThisWorkbook.Sheets(targetSheetName)
    On Error GoTo 0 ' 恢复正常错误处理
      
    If sourceSheet Is Nothing Then
        MsgBox "源工作表 " & sourceSheetName & " 不存在。", vbExclamation
        Exit Sub
    ElseIf Not targetSheet Is Nothing Then
        MsgBox "目标工作表名称 " & targetSheetName & " 已存在，请使用其他名称。", vbExclamation
        Exit Sub
    End If
      
    ' 复制源工作表
    sourceSheet.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
      
    ' 重命名新工作表
    Dim newSheet As Worksheet
    Set newSheet = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    newSheet.Name = targetSheetName
      
    ' 提示用户工作表已成功复制和重命名
    MsgBox "工作表 " & sourceSheetName & " 已成功复制并重命名为 " & targetSheetName & "。", vbInformation
End Sub