VBA宏运行时错误'-2147221080 (800401a8)'：Automation error求助

问题描述 #

运行以下VBA代码时遇到运行时错误'-2147221080 (800401a8)'：Automation error，调试器指向ws.Name = x行，需修正代码。

工作表“1”的A列内容如下：

原代码：

Sub Macro2()
'
' Macro2 Macro
'
'

Dim Counter As Integer
Counter = 1
Dim x As String
x = "1"
Dim ws As Worksheet
Dim RowNumber As Integer
RowNumber = Selection.Rows.Count


For Counter = 1 To RowNumber
    ws = Sheets.Add(After:=ActiveSheet)
    Sheets("1").Select
    x = Worksheets("1").Cells(1, Counter).Value2
    ws.Select
    ws.Name = x
    Sheets("1").Select
Next Counter
End Sub

错误原因与修正方案 #

核心错误点 #

1. 对象赋值未用Set关键字：ws = Sheets.Add(...)中，Worksheet是对象类型，赋值必须使用Set，否则直接赋值会触发Automation error。
2. 单元格引用错误：目标是读取A列数据，原代码Cells(1, Counter)读取的是第1行第Counter列，与需求不符，应改为Cells(Counter, 1)读取第Counter行第1列（即A列）。
3. 冗余Select操作：频繁使用Select会降低代码效率，还可能因激活状态变化引发意外错误，直接通过对象引用操作更可靠。

修正后的代码 #

Sub Macro2()
    Dim Counter As Integer
    Dim x As String
    Dim ws As Worksheet
    Dim RowNumber As Integer
    Dim sourceWs As Worksheet
    
    ' 绑定源工作表，避免重复查找
    Set sourceWs = ThisWorkbook.Worksheets("1")
    ' 获取A列实际非空数据行数，替代Selection.Rows.Count更稳定
    RowNumber = sourceWs.Cells(sourceWs.Rows.Count, "A").End(xlUp).Row
    
    For Counter = 1 To RowNumber
        x = sourceWs.Cells(Counter, "A").Value2
        ' 跳过空值，避免工作表命名失败
        If x <> "" Then
            ' 用Set关键字赋值工作表对象
            Set ws = ThisWorkbook.Sheets.Add(After:=sourceWs)
            ws.Name = x
        End If
    Next Counter
End Sub

关键改进说明 #

• 用Set关键字给Worksheet对象赋值，解决Automation error的核心问题。
• 修正单元格引用逻辑，正确读取A列每行数据。
• 绑定源工作表对象sourceWs，减少重复查找，提升代码执行效率。
• 使用End(xlUp)获取A列实际数据行数，避免依赖选区导致的行数不准确问题。
• 增加空值判断，防止因空单元格导致工作表命名失败。

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