Vba 使用excel列中的值命名新工作簿中的工作表时遇到问题

基本上，我有一列名称，我需要浏览并使用这些名称创建一个新工作簿，每个工作表名称都来自该列。我在复印件时遇到了麻烦。这是我的密码：

Sub copySheet()
Dim oldBook As String
Dim newBook As String
Dim myRange As Range

Set myRange = Sheets("TOC").Range("O5:O381")

oldBook = ActiveWorkbook.name

For Each Cell In myRange
    If Not Cell = "" Then
        a = a + 1
        ReDim Preserve myArray(1 To a)
        myArray(a) = Cell
    End If
Next

For a = 1 To 2
    If a = 1 Then
        myArray(a).Copy
        newBook = ActiveWorkbook.name
        Workbooks(oldBook).Activate
    Else
        myArray(a).Copy After:=Workbooks(newBook).Sheets(a - 1)
End Sub

---

只需使用一个循环即可完成此操作

' Creates a blank page in a new book,
' named after the contents of cells A1:A3
' in Sheet1 of the current workbook.
Sub CreateNewWorkbook()

    Dim cell As Range           ' Used to loop over cells.
    Dim nwb As Workbook         ' Used to create new workbook.
    Dim nws As Worksheet        ' Used to create sheets.

    ' Create new workbook.
    Set nwb = Application.Workbooks.Add

    ' Add a new worksheet for each cell in the range.
    For Each cell In ThisWorkbook.Sheets("Sheet1").Range("A1:A3").Cells

        Set nws = nwb.Sheets.Add
        nws.Name = cell.Value
    Next
End Sub

这个例子还可以，但可以改进：

• 没有
• 没有检查以确保单元格包含有效的图纸名称
• 工作表和范围地址是硬编码的
• 不会删除新工作簿中的默认工作表

---

我没有完整阅读您的代码，所以我可能错了。但要添加工作表，请尝试添加工作表。添加（请参阅）。此外，您还将oldBook和newBook都称为

ActiveWorkbook

：有些地方不对劲。如果代码在旧工作簿中，请使用

oldBook=thiswoolk.name

，对于新工作簿，请硬编码名称，或根据需要创建名称。