嘿，我来帮你搞定这个问题！你的核心需求是避免重复创建同名工作表，但原来的错误处理逻辑有几个小问题导致失效，咱们一步步拆解并修正：

原代码的核心问题 #

1. 错误处理逻辑混乱：On Error GoTo Skip之后的Exit Sub会直接终止宏——如果工作表存在（没触发错误），代码会直接跳出，根本不会执行后续的复制操作；而且没有重置错误捕获，后续的文件操作出错也会跳到Skip，完全偏离预期。
2. 语法结构错误：原代码末尾多了一个End If，还有Else的位置不对，导致代码执行流程混乱。
3. 依赖Select/Activate：频繁的工作表激活不仅降低效率，还容易因窗口切换引发意外错误。
4. 未声明变量：Row、Week等变量没有声明，容易引发类型或命名冲突的问题。

修正后的完整代码 #

我重新调整了代码逻辑，用更可靠的方式判断工作表是否存在，同时优化了执行效率：

Option Explicit

Sub Macro2()
    Dim rowNum As Long ' 改用有意义的变量名，避免和内置关键字冲突
    Dim weekVal As String
    Dim completeVal As String
    Dim entityName As String
    Dim workbookEntity As String
    Dim sourceWb As Workbook
    Dim targetWs As Worksheet
    Dim locationWs As Worksheet
    
    ' 提前获取Location工作表对象，避免重复切换激活
    Set locationWs = ThisWorkbook.Sheets("Location")
    weekVal = locationWs.Range("C1").Value
    
    rowNum = 2
nextitem:
    rowNum = rowNum + 1
    
    completeVal = locationWs.Range("B" & rowNum).Value
    entityName = locationWs.Range("A" & rowNum).Value
    workbookEntity = entityName & " - Week " & weekVal & ".xlsx"
    
    ' 如果标记为已完成，直接跳过当前实体
    If UCase(completeVal) = "YES" Then GoTo nextitem
    
    ' 检查目标工作表是否存在：用辅助函数替代错误捕获，逻辑更清晰
    If SheetExists(entityName) Then
        Set targetWs = ThisWorkbook.Sheets(entityName)
    Else
        ' 新建工作表并命名（放在最后）
        Set targetWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        targetWs.Name = entityName
    End If
    
    ' 打开源工作簿（直接引用对象，不用Activate/Select）
    Set sourceWb = Workbooks.Open(Filename:=ThisWorkbook.Path & "\location\" & workbookEntity)
    
    ' 处理隐藏工作表并复制数据
    With sourceWb.Sheets("Week - Hidden")
        .Visible = True
        ' 直接复制值到目标工作表，无需选中单元格
        .Columns("A:G").Copy
        targetWs.Range("A1").PasteSpecial Paste:=xlPasteValues
        .Visible = False
    End With
    
    ' 保存并关闭源工作簿
    sourceWb.Save
    sourceWb.Close SaveChanges:=False ' 已经Save过，这里设为False避免重复提示
    
    ' 你的原代码中Item_Region变量未定义，需要补充声明或赋值逻辑
    ' 示例：如果是从Location工作表获取，可添加如下代码
    ' Dim itemRegion As String
    ' itemRegion = locationWs.Range("D" & rowNum).Value ' 假设存在D列
    ' If itemRegion = "003" Then GoTo Enditall Else GoTo nextitem
    
    ' 替代方案：当实体名称为空时停止循环（更可靠）
    If entityName <> "" Then GoTo nextitem
    
Enditall:
    ' 清理对象，释放内存
    Set targetWs = Nothing
    Set sourceWb = Nothing
    Set locationWs = Nothing
    MsgBox "所有实体处理完成！"
End Sub

' 辅助函数：检查指定工作表是否存在于工作簿中
Function SheetExists(sheetName As String, Optional wb As Workbook) As Boolean
    Dim ws As Worksheet
    If wb Is Nothing Then Set wb = ThisWorkbook ' 默认检查当前工作簿
    On Error Resume Next ' 临时忽略错误
    Set ws = wb.Sheets(sheetName)
    On Error GoTo 0 ' 重置错误捕获
    SheetExists = Not ws Is Nothing ' 工作表存在则返回True
End Function

关键改进说明 #

1. 强制变量声明：添加Option Explicit，要求所有变量必须声明，彻底避免隐式变量导致的莫名错误。
2. 工作表存在性判断：用SheetExists辅助函数替代错误捕获，逻辑更直观，不会干扰后续代码的错误处理。
3. 移除Select/Activate：直接引用Workbook和Worksheet对象，不仅让代码运行更快，还避免了因窗口切换导致的下标越界错误。
4. 修复代码结构：清理了多余的Else和End If，让执行流程更通顺。
5. 对象清理：最后释放所有对象变量，避免内存泄漏。

为什么原来的On Error逻辑失效？ #

• 你在Sheets(Entity).Select之后加了Exit Sub，这意味着如果工作表存在（没触发错误），宏会直接终止，根本不会执行复制数据的步骤。
• 没有用On Error GoTo 0重置错误捕获，后续的Workbooks.Open等操作如果出错，也会跳到Skip标签，导致逻辑完全混乱。
• 原代码的语法错误（多余的End If）也会让VBA无法正确解析执行流程。

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