根據列表創建新工作表

Question

當我根據下面的VBA代碼創建新工作表時，它可以按我的要求工作，但是存在一個小問題。 問題是，根據Column ("A")中給出的列表創建所有工作表時，它會再創建一個與原始工作表同名的工作表，並且在此部分的代碼中也會顯示錯誤

ActiveSheet.Name = c.Value

任何助手糾正。

Private Sub CommandButton1_Click()
    On Error Resume Next
    Application.EnableEvents = False
    Dim bottomA As Integer
    bottomA = Range("A" & Rows.Count).End(xlUp).Row
    Dim c As Range
    Dim ws As Worksheet
    For Each c In Range("A2:A" & bottomA)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(c.Value)
        On Error GoTo 0
        If ws Is Nothing Then
            Sheets("Format").Select
            Sheets("Format").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = c.Value
        End If
    Next
    Application.EnableEvents = True
End Sub

Answer 1

我認為您忘記了在For語句中說明范圍將在哪個工作表上。 所以那行應該是這樣的：

對於工作表（1）.Range（“ A2：A”＆bottomA）中的每個c

在您的代碼中還存在其他問題，我剛剛進行了快速重寫。

Private Sub CommandButton1_Click()    
    Dim c As Range
    Dim ws As Worksheet
    Dim bottomA As Integer

    On Error GoTo eh

    Application.EnableEvents = False

    bottomA = Range("A" & Rows.Count).End(xlUp).Row

    For Each c In Worksheets(1).Range("A2:A" & bottomA)
       'Set ws = Nothing
       'On Error Resume Next
       'Set ws = Worksheets(c.Value)
       'On Error GoTo 0
       'If ws Is Nothing Then
        Sheets("Format").Select
        Sheets("Format").Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = c.Value
       'End If
Next
Application.EnableEvents = True

Exit Sub

eh:
    Debug.Print ""
    Debug.Print Err.Description
    MsgBox (Err.Description)
End Sub

Answer 2

嘗試盡可能明確。

Private Sub CommandButton1_Click()
    On Error GoTo halt ' Do not use OERN, that ignores the error
    Application.EnableEvents = False

    Dim bottomA As Long
    ' explicitly work on the target sheet
    With Sheets("SheetName")
        bottomA = .Range("A" & .Rows.Count).End(xlUp).Row
        Dim c As Range, ws As Worksheet, wb As Workbook
        ' explicitly define which workbook your working on
        Set wb = ThisWorkbook 
        For Each c In .Range("A2:A" & bottomA)
            On Error Resume Next
            Set ws = wb.Sheets(c.Value)
            On Error GoTo 0
            If ws Is Nothing Then
                wb.Sheets("Sheet1").Copy _
                    After:=wb.Sheets(wb.Sheets.Count)
                ActiveSheet.Name = c.Value
            End If
        Next
    End With

forward:
    Application.EnableEvents = True
    Exit Sub
halt:
    MsgBox Err.Number
    Resume forward
End Sub

我不知道您為什么需要打開/關閉事件（至少在您的示例中我不認為它是必需的）。 但是，我用更靈活的錯誤處理例程替換了On Error Resume Next ，因為您所做的只是忽略了任何錯誤。 還要進行檢查 ，以改善您使用對象的方式，並避免不必要地使用Active[object]和Select 。