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语句中忘记了该范围将在哪个工作表上。那条线应该是这样的：

对于工作表中的每个c（1）.Range（“A2：A”＆amp; bottomA）

您的代码中还有其他问题，我只是快速重新编写..

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，因为你所做的只是忽略了任何错误。 Check this out也可以改善您处理对象的方式，避免不必要地使用Active[object]和Select。

根据列表创建新工作表

2 个答案: