无法使用Excel中的列中的值来命名新工作簿中的工作表

Question

基本上，我有一列值得我需要经过并用于创建新工作簿的名称，每个工作表名称都来自柱。我在复制过程中遇到问题。这里是我的代码：

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 

Answer 1

你可以使用只有一个循环。

' 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 

这个例子是确定的，但它可以改进：

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