2013-10-27 78 views
1

我正在嘗試創建一個將複製實際工作表並將其命名爲下一個字母的宏的宏。工作簿中始終存在第一張工作表「A」,其他工作表(B,C,D等)將根據需要添加。我設法把下面一段可以創建表「B」的代碼放在一起。問題是當複製工作表「B」時,運行時錯誤「1004」表示最後一行代碼有錯誤。如何按字母順序命名Excel工作表?

Sub newList() 
' New_List Macro 
Dim PrevLetter As String 

PrevLetter = "ActiveSheet.Name" 
ActiveSheet.Copy after:=ActiveSheet 
ActiveSheet.Name = Chr(Asc(PrevLetter) + 1) 

End Sub 

你們能幫忙嗎?

回答

1

Soren提到你的代碼給出錯誤。

但是,如果工作表「A」在創建「B」後已經激活,並且工作表「B」已經存在,那麼您的代碼將會出錯。

您可能想試試這個嗎?爲此,哪個紙張處於活動狀態並不重要。此外,這段代碼將允許您創建超出Z的工作表。所以Z後,張將被命名爲AAAB等。

  • 使用此代碼,在XL2007 +您可以創建表截至XFD(更多16383張)
  • 使用此代碼,在XL2003您可以創建片向上直到IV(更255張)

CODE:

Sub newList() 
    Dim PrevLetter As String 
    Dim ws As Worksheet, wsNew As Worksheet 
    Dim wsname As String 

    Set ws = ThisWorkbook.Sheets("A") 
    ws.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 
    Set wsNew = ActiveSheet 
    wsname = GetNewName 
    wsNew.Name = wsname 
End Sub 

Function GetNewName() As String 
    Dim NewWs As Worksheet 

    For i = 2 To ThisWorkbook.Sheets(1).Columns.Count 
     ColName = Split(ThisWorkbook.Sheets(1).Cells(, i).Address, "$")(1) 
     On Error Resume Next 
     Set NewWs = ThisWorkbook.Sheets(ColName) 

     If Err.Number <> 0 Then 
      GetNewName = ColName 
      Exit For 
     End If 
    Next i 
End Function 
+1

。但是,所有變種都適用,因爲可以從任何工作表創建新工作表,所以Siddharth的解決方案對我來說確實非常有用。謝謝你們,夥計們。@Søren,@ Chris – Dan

1

你應該簡單地寫你這樣的代碼來代替:

Sub newList() 
' New_List Macro 
Dim PrevLetter As String 

PrevLetter = ActiveSheet.Name    '<--- Change made to this line 
ActiveSheet.Copy after:=ActiveSheet 
ActiveSheet.Name = Chr(Asc(PrevLetter) + 1) 

End Sub 

編輯:這不是一個「最佳實踐代碼」的答案。這只是指出你自己的代碼中返回錯誤的內容。這個問題的其他答案(到目前爲止)確實是解決這個問題的更復雜和更正確的方法。

0

這裏是另一種方式,你可以這樣做:我真的很驚訝,這麼快就收到答覆

Sub newList() 
' New_List Macro 
    Dim PrevLetter As String 
    Dim wb As Workbook 
    Dim ws1 As Worksheet 

    Set wb = ActiveWorkbook 
    Set ws1 = wb.ActiveSheet 
    PrevLetter = ws1.Name 
    ws1.Copy After:=ws1 
    Sheets(Sheets.Count).Name = Chr(Asc(PrevLetter) + 1) 

    Set wb = Nothing 
    Set ws1 = Nothing 

End Sub