VBA批量删除工作簿中名称含_Deal工作表指定列问题求助

• 删除列逻辑未绑定遍历对象：你代码中的Columns(7).EntireColumn.Delete未指定所属工作表，默认只操作当前激活的工作表，即使遍历到其他符合条件的工作表，实际操作的还是同一个激活表，因此仅第一个符合条件的工作表有修改效果。
• 复制逻辑存在隐藏缺陷：遍历工作表集合的同时插入新工作表，会导致后续遍历命中新生成的_Deal后缀表，出现重复复制生成xxx_Deal_Deal这类错误命名的问题。

以下是可直接运行的完整代码，覆盖你所有需求：

Sub BatchProcessSheets()
    Dim oriSheetNames As Variant
    Dim i As Long
    Dim curWs As Worksheet
    
    ' 关闭不必要的提示和屏幕刷新提升运行效率
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 1. 预存原有所有工作表名称，避免复制时重复处理新生成的表
    ReDim oriSheetNames(1 To ThisWorkbook.Sheets.Count)
    For i = 1 To ThisWorkbook.Sheets.Count
        oriSheetNames(i) = ThisWorkbook.Sheets(i).Name
    Next
    
    ' 批量生成带_Deal后缀的副本
    For i = LBound(oriSheetNames) To UBound(oriSheetNames)
        Set curWs = ThisWorkbook.Sheets(oriSheetNames(i))
        curWs.Copy Before:=ThisWorkbook.Sheets(1)
        ActiveSheet.Name = curWs.Name & "_Deal"
    Next
    
    ' 2. 为所有_Deal后缀的工作表删除7-10列（G-J列）
    For Each curWs In ThisWorkbook.Sheets
        If InStr(curWs.Name, "_Deal") > 0 Then
            ' 显式绑定当前遍历到的工作表，避免操作错对象
            curWs.Range("G:J").EntireColumn.Delete
        End If
    Next
    
    ' 3. 此处插入你已调试完成的副本保存到新工作簿的代码
    ' --------------------
    ' 你的保存代码写在这里
    ' --------------------
    
    ' 4. 删除原工作簿内所有_Deal后缀的工作表
    For Each curWs In ThisWorkbook.Sheets
        If InStr(curWs.Name, "_Deal") > 0 Then
            curWs.Delete
        End If
    Next
    
    ' 恢复Excel默认配置
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

核心修正点 #

• 预存原有工作表名称列表，从根源避免复制逻辑重复生成冗余副本
• 所有工作表操作都显式绑定遍历对象curWs，不会出现操作错表的问题
• 一次性指定G-J列删除，无需循环处理单列，运行效率更高

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