1

実際のシートをコピーして、アルファベットの次の文字で名前を付けるマクロを作成しようとしています。最初のシート「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

どなたか助けていただけませんか？

4

3 に答える 3

1

Sorenが述べたように、あなたのコードはエラーを出しています。

ただし、シート「B」が既に存在するため、「B」の作成後にシート「A」がアクティブな場合、コードでエラーが発生します。

これを試してみませんか？このため、どのシートがアクティブであるかは重要ではありません。また、このコードを使用すると、 を超えるシートを作成できますZ。したがって、以降のシートはなどのZ名前になります。AAAB

  • XFDこのコードを使用すると、XL2007+ では最大16383 シートまでシートを作成できます。
  • IVこのコードを使用すると、XL2003 では最大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
于 2013-10-27T09:06:56.903 に答える
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

編集:これは「ベスト プラクティス コード」の回答ではありません。これは、自分のコードで何がエラーを返しているかを示しているだけです。この質問に対する他の回答 (これまでのところ) は、この問題を解決するためのより洗練された正しい方法です。

于 2013-10-27T08:48:38.933 に答える
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
于 2013-10-27T09:09:07.170 に答える