遍历新旧Excel工作簿：按需重命名工作表并执行指定VBA代码

修改后的完整代码 #

Sub CD3()
    Dim wb As Workbook
    Dim ws As Worksheet
    
    ' 遍历所有打开的工作簿
    For Each wb In Application.Workbooks
        ' 处理受保护视图的工作簿
        If Not wb.ProtectedViewWindow Is Nothing Then
            wb.ProtectedViewWindow.Edit
            ' 编辑后重新获取可编辑状态的工作簿对象
            Set wb = Application.Workbooks(wb.Name)
        End If
        
        ' --------------------------
        ' 核心：检查并重命名旧格式工作表
        ' --------------------------
        ' 重命名"01"为"newname01"（仅当存在"01"时执行）
        On Error Resume Next
        Set ws = wb.Sheets("01")
        If Err.Number = 0 Then
            ws.Name = "newname01"
        End If
        On Error GoTo 0
        
        ' 重命名"02"为"newname02"（仅当存在"02"时执行）
        On Error Resume Next
        Set ws = wb.Sheets("02")
        If Err.Number = 0 Then
            ws.Name = "newname02"
        End If
        On Error GoTo 0
        
        ' --------------------------
        ' 后续处理（统一使用新表名）
        ' --------------------------
        With wb.Sheets("newname01")
            .Range("A8:B10").Orientation = 90
            .Range("C10:D10").Orientation = 90
            .Range("E8:F10").Orientation = 90
            .Range("G10:H10").Orientation = 90
            .Range("I8:J10").Orientation = 90
            .Range("K10:N10").Orientation = 90
            .Range("O8:Q10").Orientation = 90
            .Range("Q8:Q10").FormulaR1C1 = "Observation/ Proposals"
        End With
        
        ' 添加新工作表并命名为"03"（避免重复添加）
        On Error Resume Next
        Set ws = wb.Sheets("03")
        If Err.Number <> 0 Then
            Set ws = wb.Sheets.Add(After:=wb.Sheets("newname02"))
            ws.Name = "03"
        End If
        On Error GoTo 0
        
        ' 更多代码...
        
        ' 调整窗口设置
        With wb.Windows(1)
            .Zoom = 75
            .ScrollRow = 1
            .ScrollColumn = 1
        End With
        wb.Sheets("newname01").Range("A11").Select
        
        ' 保存并关闭工作簿
        wb.Save
        wb.Close
    Next wb ' 修正原代码循环变量错误
End Sub

关键改进点说明 #

1. 安全的工作表重命名逻辑：

   • 通过On Error Resume Next尝试获取旧名称工作表，只有工作表存在时才执行重命名，彻底避免因不存在旧表名导致的报错。
   • 每次检查后恢复错误捕获（On Error GoTo 0），防止后续代码的错误被忽略。

2. 摒弃不稳定的Select操作：

   • 使用With语句直接引用目标工作表，操作其Range对象，比依赖Select更稳定，不会因当前活动表变化而出错。

3. 修复编译错误：

   • 原代码循环变量为wb，但结尾写Next ws，修正为Next wb解决编译报错。

4. 优化受保护视图处理：

   • 直接针对当前遍历的工作簿处理受保护视图，而非全局活动窗口，避免多窗口场景下的逻辑混乱；编辑后重新获取工作簿对象，确保后续操作的是可编辑状态的文件。

5. 避免重复添加工作表：

   • 先检查是否已有"03"工作表，仅在不存在时才执行添加操作，避免名称冲突错误。

可选：更直观的工作表存在性检查函数 #

如果觉得用错误捕获不够直观，可以封装以下函数替代：

Function SheetExists(sheetName As String, wb As Workbook) As Boolean
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = wb.Sheets(sheetName)
    SheetExists = (Err.Number = 0)
    On Error GoTo 0
End Function

然后在主代码中替换重命名逻辑：

If SheetExists("01", wb) Then
    wb.Sheets("01").Name = "newname01"
End If
If SheetExists("02", wb) Then
    wb.Sheets("02").Name = "newname02"
End If

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