求助Excel VBA循环创建工作表代码：解决复制与命名报错问题

嘿，作为VBA新手碰到这种问题太正常啦！我帮你梳理下报错的核心原因，再给你一个完全符合需求的解决方案～

先说说你代码报错的关键原因 #

1. Selection.Copy 不稳定：这个命令完全依赖当前选中的单元格，一旦代码运行过程中选中范围意外改变，或者你没提前选对区域，就会直接报错。VBA里尽量避免用Selection，直接引用具体范围才是靠谱的做法。
2. ActiveSheet.Name 容易踩坑：ActiveSheet指的是当前激活的工作表，有时候创建新表后激活状态可能不符合预期；而且如果D列有重复值、或者包含工作表名称不允许的字符（比如/:*?"<>|），也会直接触发命名报错。

量身定制的修正代码 #

这个代码会逐个创建工作表、立即命名、然后执行粘贴值+公式操作，完全避开一次性创建再重命名的问题，稳定性拉满：

Sub CreateSheetsAndRunFormulas()
    Dim wsSource As Worksheet
    Dim wsNew As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim sheetName As String
    
    ' 替换成你存放D列数据的工作表名称（比如"数据源"）
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    
    ' 自动找到D列最后一行有数据的行（不用手动改行数）
    lastRow = wsSource.Cells(wsSource.Rows.Count, "D").End(xlUp).Row
    
    ' 遍历D列的每个单元格（假设第1行是表头，从第2行开始）
    For i = 2 To lastRow
        sheetName = wsSource.Cells(i, "D").Value
        
        ' 先检查名称是否合法、是否已存在
        If IsValidSheetName(sheetName) Then
            If Not SheetExists(sheetName) Then
                ' 创建新工作表，直接用变量引用（不用ActiveSheet）
                Set wsNew = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
                wsNew.Name = sheetName ' 直接给变量对应的表命名，不会出错
                
                ' --- 这里替换成你需要的操作 ---
                ' 示例：复制源表的A1:C20到新表A1，只粘贴值
                wsSource.Range("A1:C20").Copy
                wsNew.Range("A1").PasteSpecial Paste:=xlPasteValues
                
                ' 运行第一个公式（比如新表D1）
                wsNew.Range("D1").Formula = "=SUM(A1:A20)"
                ' 运行第二个公式（比如新表E1）
                wsNew.Range("E1").Formula = "=VLOOKUP(A1, 数据源!A:B, 2, FALSE)"
                
                ' 清除剪贴板，避免弹窗干扰
                Application.CutCopyMode = False
            Else
                MsgBox "工作表 '" & sheetName & "' 已经存在，跳过创建！"
            End If
        Else
            MsgBox "单元格D" & i & "的值 '" & sheetName & "' 不合法（含特殊字符/过长/为空），跳过！"
        End If
    Next i
    
    MsgBox "所有操作完成啦！"
End Sub

' 辅助函数：检查工作表名称是否符合Excel规则
Function IsValidSheetName(name As String) As Boolean
    Dim invalidChars As Variant
    Dim char As Variant
    
    invalidChars = Array("/", "\", ":", "*", "?", """", "<", ">", "|")
    IsValidSheetName = True
    
    ' 检查是否为空或长度超过31（Excel工作表名称最长31字符）
    If name = "" Or Len(name) > 31 Then
        IsValidSheetName = False
        Exit Function
    End If
    
    ' 检查是否包含非法字符
    For Each char In invalidChars
        If InStr(name, char) > 0 Then
            IsValidSheetName = False
            Exit Function
        End If
    Next char
End Function

' 辅助函数：检查同名工作表是否已存在
Function SheetExists(name As String) As Boolean
    Dim ws As Worksheet
    On Error Resume Next ' 忽略找不到工作表的错误
    Set ws = ThisWorkbook.Worksheets(name)
    On Error GoTo 0 ' 恢复错误处理
    SheetExists = Not ws Is Nothing ' 如果找到工作表就返回True
End Function

关键改进点说明（新手必看） #

• 抛弃Selection和ActiveSheet：用wsSource（源数据工作表）和wsNew（新创建的工作表）这两个变量直接操作，完全不依赖选中/激活状态，从根源避免报错。
• 提前做合法性检查：先确认D列的值能不能当工作表名称、有没有重复，不会再因为命名问题崩溃。
• 逐个流程执行：每循环一次就创建一个表、命名、完成粘贴和公式操作，完全符合你“逐个处理”的需求，不是一次性创建所有表再批量操作。

你需要修改的地方 #

1. 把Set wsSource = ThisWorkbook.Worksheets("Sheet1")里的Sheet1改成你实际存放D列数据的工作表名称（比如“数据源”）。
2. 把复制范围wsSource.Range("A1:C20")改成你要复制的实际区域。
3. 把两个公式wsNew.Range("D1").Formula = ...和wsNew.Range("E1").Formula = ...替换成你需要的公式，调整单元格位置。

内容的提问来源于stack exchange，提问作者Vicky del Real