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

基本上，我有一个列名称，我需要通过并使用创build一个新的工作簿，每个工作表名称是从列。 我在复制过程中遇到麻烦。 这是我的代码：

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