根据列表创建新工作表

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 。