無法使用Excel中的列中的值來命名新工作簿中的工作表

基本上，我有一列值得我需要經過並用於創建新工作簿的名稱，每個工作表名稱都來自柱。我在複製過程中遇到問題。這裏是我的代碼：無法使用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

來源

2017-06-13 user8137539

我沒有讀完你的代碼，所以我可能是錯的。但對於添加工作表，請嘗試'Sheets.Add'（請參閱[這裏]（https://stackoverflow.com/a/3840728/1726522））。此外，您將oldBook和newBook都稱爲「ActiveWorkbook」：出現問題。如果代碼在舊工作簿中，請使用'oldBook = Thisworkbook.name'，並且新代碼可以硬編碼名稱，或者根據您的需要創建它。 – CMArg

你可以使用只有一個循環。

' 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。
沒有檢查以確保單元格包含有效的工作表名稱。
工作表和範圍地址是硬編碼的。
新工作簿中的默認工作表不會被刪除。

來源

2017-06-13 16:38:14

無法使用Excel中的列中的值來命名新工作簿中的工作表

回答

相關問題