制造业报表提速：Excel VBA复制工作表并按规则重命名求助

以下是完善后的VBA代码，可实现你需要的工作表复制与按规则重命名逻辑：

Sub CopySheetRename()
    Dim originalSheet As Worksheet
    Dim originalName As String
    Dim nameParts() As String
    Dim rNum As Integer
    Dim dNum As Integer
    Dim newName As String
    
    ' 记录被复制的原工作表（复制前的最后一张工作表）
    Set originalSheet = Sheets(Sheets.Count)
    ' 复制原工作表到工作簿末尾
    originalSheet.Copy After:=Sheets(Sheets.Count)
    
    ' 获取原工作表名称并拆分
    originalName = originalSheet.Name
    ' 按空格拆分名称，得到Rxxx和Dxx两部分
    nameParts = Split(originalName, " ")
    
    ' 提取R后的数字（去掉前缀"R"）
    rNum = CInt(Mid(nameParts(0), 2))
    ' 提取D后的数字（去掉前缀"D"）
    dNum = CInt(Mid(nameParts(1), 2))
    
    ' 根据规则生成新名称
    If dNum = 2 Then
        ' D2 → D9，R编号不变
        newName = "R" & rNum & " D9"
    ElseIf dNum = 9 Then
        ' D9 → D2，R编号+1
        newName = "R" & (rNum + 1) & " D2"
    End If
    
    ' 给新工作表重命名
    On Error Resume Next
    ActiveSheet.Name = newName
    On Error GoTo 0
End Sub

关键逻辑说明 #

• 锁定原工作表：复制前先记录当前工作簿的最后一张表（即待复制的目标表），避免复制后无法准确获取原表名称
• 拆分名称结构：用Split函数按空格拆分原名称，分离出R编号和D编号两个独立部分
• 提取核心数字：通过Mid函数去掉前缀"R""D"，再转成整数类型实现数值运算
• 规则匹配处理：针对两种预设场景分别生成新名称：
  • 原表为D2时，保留R编号，将D编号改为9
  • 原表为D9时，R编号自增1，D编号改回2
• 错误防护：保留原有错误捕获逻辑，避免因重名等异常导致代码中断

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