根据列表创建新工作表

Question

When I create new sheets based on the below VBA Code, it works as I want, but there is a small problem. The issue is that when creating all the sheets based on the list given in Column ("A") , it create one more sheet with the same name of the original one and also show an error in the code in this section

ActiveSheet.Name = c.Value

Any assistant to correct.

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

I think you forgot in your For statement to state which worksheet the range will be on. So that line should be something like this:

For Each c in worksheet(1).Range("A2:A" & bottomA)

Also there other issue in your code, I just made quick re-write..

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

Try to be explicit as much as possible.

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

I don't know why you need to turn events On/Off (I don't see it required at least for your example). Nonetheless, I replaced the On Error Resume Next with a more flexible error handling routine because what you did is simply ignoring any errors. Check this out as well to improve how you work with objects and avoid unnecessary use of Active[object] and Select .