Macro to Split Data Onto Separate Sheets

Hi, Everyone,

I have a long list of data for numerous companies, and I'd like to separate it out onto different tabs. In the attachment, you'll see data on Tab 1 with (sample) spending for several companies. I would like to split that onto separate sheets--one sheet per advertiser.

Would someone mind providing some help with this? It would be greatly appreciated!


ExcelExample - Need Data Separated.xlsx

Sub craetenames()
Dim i As Long, LR As Long, NR As Long, nome As String, sh As Worksheet, ws As Worksheet

    Application.ScreenUpdating = False
    On Error Resume Next
    
    For Each ws In ThisWorkbook.Worksheets
        With ws
            If .Name <> "Source Data" Then
            .Cells.ClearContents
            End If
        End With
    Next ws
    
        With Sheets("Source Data")
            LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
            For i = 2 To LR
                If Trim(.Range("A" & i).Value) <> vbNullString Then
                    nome = Trim(.Range("A" & i).Value)
                    If Not Evaluate("ISREF('" & nome & "'!A1)") Then
                    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = nome
                    End If
                    .Range("A1:F1").Copy Worksheets(nome).Range("A1")
                    .Rows(i).Copy
                    Worksheets(nome).Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial (xlPasteValuesAndNumberFormats)
                End If
            Next i
        Application.CutCopyMode = 0
       End With
       
            For Each sh In ThisWorkbook.Worksheets
                Application.DisplayAlerts = 0
                If InStr((sh.Name), "Sheet") > 0 Then sh.Delete
                 sh.Cells.Columns.AutoFit
            Next
        
     Application.ScreenUpdating = True
     Application.DisplayAlerts = 1
End Sub

Thanks, that's amazing! One problem though: When I run the report on the real file (which contains more than 3 companies), it works for the first three companies, then produces nearly 100 blank sheets, and towards the end of the workbook I find the additional company names.

Any ideas?

Again, thank you very much!

Excel is senstive when it comes to creating names. There are many restrictions on naming excel sheets. If excel does not like the name, it just create a blank name. It will not show an error as I have included an error trapping on the code. Having known this issue for some time now, I have inlcuded on the code to delete any names which are not valid names(sheets) from the workbook. So, when ever you run the code, it will delete these empty sheets. If you see any sheet which is not company name, let me know and will have a look again.

Try this

Option Explicit

Sub test()
    Dim x, y, e
    Application.ScreenUpdating = False
    With Sheets("source data").Range("a1").CurrentRegion
        .Parent.AutoFilterMode = False
        With .Columns(1).Resize(.Rows.Count - 1).Offset(1)
            x = .Address
            .Value = .Parent.Evaluate("if(" & x & "<>"""",trim(" & x & "),"""")")
            y = Filter(Evaluate("transpose(if(countif(offset(" & x & _
            ",0,0,row(1:" & .Rows.Count & "))," & x & ")=1," & x & ",char(2)))"), Chr(2), 0)
        End With
        For Each e In y
            If Not IsSheetExists(CStr(e)) Then
                Sheets.Add(after:=Sheets(Sheets.Count)).Name = e
            End If
            Sheets(CStr(e)).Cells.Clear
            .AutoFilter 1, e
            .Copy Sheets(e).Cells(1)
            Sheets(e).Range("a1").CurrentRegion.Columns.AutoFit
            .AutoFilter
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Function IsSheetExists(ByVal txt As String) As Boolean
    On Error Resume Next
    IsSheetExists = Len(Sheets(txt).Name)
    On Error GoTo 0
End Function

Thanks for putting that together. Unfortunately, I"m getting an error after Company 3. I tried debugging and it pointed to this line:

"Sheets.Add(after:=Sheets(Sheets.Count)).Name = e"

Originally Posted by kestefon

"Sheets.Add(after:=Sheets(Sheets.Count)).Name = e"

When you debug, what was the name, variable e ?
You can move the cursor over "e" and name should come up.

Notice:
You can not use the string such as:
1) Exceeds the length of 31 characters.
2) Contains invalid character(s). i.e "?", "\", "/", "[", "]", "*", ":"

Do you still have issues with my code?

Thanks, jindon. In this case the sheet had one of the invalid characters.

Then you need to delete it, no choice.