CODEWITHSUNDEEP
excelvba
NantyNarking
NantyNarking

Reputation: 33

Split a Master Workbook into Multiple Workbooks in Excel using VBA

I got this code from a YouTube tutorial (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

I receive an error

That name is already taken. Try a different one.

on

ActiveSheet.Name = cell.Value

It seems like it copies the "Master" sheet in its entirety instead of going through the rest of the filtering/copying process because it makes a Master (2) & Master (3) sheet each time I hit run.

Upvotes: 3

Views: 384

Answers (1)

Tim Williams
Tim Williams

Reputation: 166491

Your error message is because the code is trying to rename a sheet using a name which already exists. Your code is pretty much a "run once" method.

You can handle the error by first deleting any existing sheet.

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

Upvotes: 4

Related Questions