Как написать таблицы Excel в алфавитном порядке?

Question

Я пытаюсь создать макрос, который скопирует фактический лист и назовет его следующей буквой алфавита. Первый лист «A» всегда существует в книге, при необходимости добавляются другие листы (B, C, D и т. Д.). Мне удалось собрать следующий фрагмент кода, который может создать лист «B». Проблема в том, что при копировании листа «B» я получаю ошибку времени выполнения «1004», указывающую на ошибку в последней строке кода.

Sub newList() 
' New_List Macro 
Dim PrevLetter As String 

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

End Sub 

Может ли кто-нибудь из вас помочь?

Answer 1

Ваш код указывает на то, что упомянул Сорен.

Однако ваш код даст ошибку, если лист «A» активен после создания «B», поскольку лист «B» уже существует.

Возможно, вы захотите попробовать это? для этого не важно, какой лист активен. Также этот код позволит вам создавать листы за пределами Z. Так листы после Z будет называться AA, AB и т.д ..

• Используя этот код, в XL2007 + вы можете создать листы вверх до XFD (более 16383 листов)
• Используя этот код, В XL2003 вы можете создать листы до IV (более 255 листов)

КОД:

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 

Answer 2

Вы должны просто написать код, как это вместо:

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 

EDIT: Это не «наилучшей практики код» ответ. Это просто указывает, что в вашем собственном коде возвращалась ошибка. Другие ответы на этот вопрос (до сих пор) на самом деле гораздо более сложные и правильные пути решения этой проблемы.

Answer 3

Вот еще один способ, которым Вы могли бы сделать это:

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