使用VBA将一个主工作簿拆分成多个工作簿，Excel教程

Question

我从一个YouTube教程（https://www.youtube.com/watch?v=5bOFNsdHiPk&t=326s）中得到了这段代码。

Sub SplitandFilterSheet()
    'Step 1 - Name your ranges and Copy sheet
    'Step 2 - Filter by Department and delete rows not applicable
    'Step 3 - Loop until the end of the list
    Dim Splitcode As Range
    Sheets("Master").Select
    Set Splitcode = Range("Splitcode")
    
    For Each cell In Splitcode
        Sheets("Master").Copy After:=Worksheets(Sheets.Count)
        ActiveSheet.Name = cell.Value
    
        With ActiveWorkbook.Sheets(cell.Value).Range("MasterData")
            .AutoFilter Field:=4, Criteria1:="<>" & cell.Value, Operator:=xlFilterValues
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With
    
        ActiveSheet.AutoFilter.ShowAllData
    Next cell
End Sub

我收到一个错误

该名称已被使用，请尝试其他名称。

在

ActiveSheet.Name = cell.Value

看起来它复制了整个“Master”工作表，而不是继续进行其余的过滤/复制过程，因为每次我运行它时都会创建一个“Master (2)”和“Master (3)”工作表。

- NantyNarking

Answer 1

您的错误提示是因为代码试图使用已存在的名称重命名工作表。您的代码基本上是一个“运行一次”的方法。

您可以通过首先删除任何现有的工作表来处理错误。

Sub SplitandFilterSheet()

    Dim Splitcode As Range, wb As Workbook, cell As Range, nm As String
    Dim wsMaster As Worksheet

    Set wb = ActiveWorkbook
    Set wsMaster = wb.Sheets("Master")
    Set Splitcode = wsMaster.Range("Splitcode")
    
    For Each cell In Splitcode.Cells
        nm = cell.Value

        On Error Resume Next   'ignore error if no sheet with this name
        wb.Sheets(nm).Delete   'delete any existing sheet with this name
        On Error Goto 0        'stop ignoring errors

        wsMaster.Copy After:=wb.Worksheets(wb.Sheets.Count)
        With wb.Worksheets(wb.Sheets.Count)
            .Name = nm
            With .Range("MasterData")
                .AutoFilter Field:=4, Criteria1:="<>" & nm, Operator:=xlFilterValues
                .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            End With
            .AutoFilter.ShowAllData
        End with
    Next cell
End Sub

- Tim Williams

---

稍微调整了一下，我让你的代码可以工作了！非常感谢！ - NantyNarking

@NantyNarking 在这种情况下，您可以将此答案标记为已接受。 - FunThomas