VBA代码首次运行报Run time error '438'，再次运行正常求助

咱们来拆解你遇到的问题：Runtime Error 438是对象不支持该属性或方法，核心原因是新代码里的对象类型不匹配，再加上代码逻辑有不少隐患，才导致首次运行报错、第二次巧合能执行的奇怪现象。

问题代码的核心错误分析 #

新代码的问题点 #

• Sheets("Sheet1").Copy 执行后，会自动新建一个包含Sheet1副本的工作簿，这个新工作簿就是ActiveWorkbook。但你接下来写的Set wb = ActiveWorkbook.Sheets("Sheet1").Add完全错误：Sheets.Add返回的是工作表对象，但你把它赋值给Workbook类型的变量wb，类型不匹配直接触发438错误。
• 定义了strFileName但完全没用到，路径拼接也不完整（C:\Users\后面缺少用户名）。
• wb.Close如果wb是工作表对象，调用Close方法本身就不符合对象的方法定义，第二次运行只是巧合没触发报错而已。

原代码的问题点 #

• strFileName = "C:\Users\" & Sheets("Sheet1").Name & ".xls" 路径无效，C:\Users\后需要指定当前用户目录，应该用Environ("USERPROFILE")获取。
• If strFileName = "False" Then Exit Sub 逻辑无效：strFileName是字符串，永远不可能等于"False"，这个判断完全起不到作用。
• ActiveWorkbook.Close0 语法错误，正确写法是ActiveWorkbook.Close SaveChanges:=False（或简写Close False）。
• Range("B4")等单元格引用没有指定工作表，容易因为当前活动表变化导致错误。

修正后的稳定代码 #

以下是修复所有问题后的代码，注释里说明了每一步的作用：

Sub CopyAndSaveSheet()
    Dim sourceSheet As Worksheet
    Dim newWorkbook As Workbook
    Dim savePath As String
    
    ' 明确指定源工作表，避免活动表变化导致错误
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    
    ' 复制源工作表到新工作簿（自动创建新工作簿并设为活动状态）
    sourceSheet.Copy
    
    ' 获取新创建的工作簿对象
    Set newWorkbook = ActiveWorkbook
    
    ' 构建保存路径：使用当前用户目录，结合单元格值和日期
    ' 注意：确保B4、E6、E7单元格内容不会包含文件名非法字符（如\/:*?"<>|）
    savePath = Environ("USERPROFILE") & "\" & _
               sourceSheet.Range("B4").Value & _
               sourceSheet.Range("E6").Value & " vs " & _
               sourceSheet.Range("E7").Value & " - " & _
               Format(Date, "dd-mm-yyyy") & ".xls"
    
    ' 保存新工作簿（指定xls格式对应xlExcel8）
    newWorkbook.SaveAs Filename:=savePath, FileFormat:=xlExcel8
    
    ' 关闭新工作簿（不提示保存，因为刚保存过）
    newWorkbook.Close SaveChanges:=False
End Sub

关键优化点说明 #

• 明确对象引用：用ThisWorkbook指代包含当前VBA代码的工作簿，避免ActiveWorkbook带来的不确定性。
• 类型匹配：正确将新工作簿对象赋值给Workbook类型变量，彻底解决438错误。
• 合法路径：用Environ("USERPROFILE")获取当前用户的目录，确保路径有效。
• 避免语法错误：修正Close方法的写法，明确指定保存参数。
• 安全的单元格引用：所有Range都绑定到sourceSheet，防止活动表变化导致引用错误。

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