Split a Master Spreadsheet into Multiple Sheets in Excel using VBA

user_15425500 0
Viewed 173

(Apologies I'm new here so please bare with me haha) So I got this code from a YouTube tutorial (https://www.youtube.com/watch?v=5bOFNsdHiPk&t=326s) and I was hoping I could receive some further help...

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 keep receiving a "That name is already taken. Try a different one." error on line (ActiveSheet.Name = cell.Value). It seems like it just 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.

vba excel
1 Answers

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
user_4788840
Related