创建新副本VBA
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
页:
[1]