Split Data based on 3 Columns into separate worksheets

Hello,

I need to split the data into worksheets (see attached) by the Advertiser column and then by the deal year and deal code columns. I need each worksheet to be named per advertiser and deal year_deal code. I took off and replaced the data since it is sensitive information.

Need help creating a macro or implicating one into the workbook to run for future reporting.

Thank you!

Give a chance to next code.
It assume data is in sheet "Data"

Option Explicit

Sub SplitData()
Dim ObjDic   As Object
Dim F  As Range
Dim WS  As Worksheet
Dim G
Dim Rng  As Range
Dim Temp
    Application.ScreenUpdating = False
    Set ObjDic = CreateObject("Scripting.Dictionary")
    With Sheets("Data")
'-------   PREPARE LIST  OF  SHEETS
        For Each F In .Range(.Cells(6, "A"), .Cells(Rows.Count, "A").End(xlUp))
            ObjDic.Item(F.Offset(, 2) & "_" & F.Offset(, 4).Value & "_" & F.Offset(, 5).Value) = _
             F.Offset(, 2) & "/" & F.Offset(, 4).Value & "/" & F.Offset(, 5).Value
        Next F
    End With
    DDD = ObjDic.keys
'-------   DELETE  SHEET IF  ALREADY  EXIST
    For Each WS In ActiveWorkbook.Sheets
        If (ObjDic.exists(WS.Name)) Then
            Application.DisplayAlerts = False
            WS.Delete
            Application.DisplayAlerts = True
        End If
    Next WS
'-------   CREATE  SHEETS
    For Each G In ObjDic.keys
        Worksheets.Add After:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Name = G
    Next G
'-------   COPY  DATA
    With Sheets("Data")
        If (.AutoFilterMode) Then .AutoFilterMode = False '  REMOVE  AUTOFILTER  IF  EXIST
        Set Rng = .Range("A5", .Range("A5").SpecialCells(xlCellTypeLastCell))
        For Each G In ObjDic.keys
            Temp = Split(ObjDic.Item(G), "/")
            With Rng
                Rng.AutoFilter Field:=3, Criteria1:=Temp(0)
                Rng.AutoFilter Field:=5, Criteria1:=Temp(1)
                Rng.AutoFilter Field:=6, Criteria1:=Temp(2)
                .SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(G).Cells(1, 1)
            End With
        Next G
    End With
    Application.ScreenUpdating = True

Thank you! For some reason it keeps saying error. The 'Sub SplitData()' is highlighted in yellow and 'DDD = ObjDic.keys'. Is there something I am doing wrong? Can you give me step by step detail on how to run the macro?

About the 'DDD = ObjDic.keys' statement, remove it, it was for debugging.
Does the macro working with the file sent?

Thank you, I took out the debug info.

It worked with your file but when I copy and paste the actual data under the Range it now keeps giving me an error and highlighting 'Worksheets(Worksheets.Count).Name = G'

Without a sample of your data it will difficult to understand...
Can you prepare a sample.

An issue is the sheet's name length : maxi = 30
Do a test with your data

how do I change the count? It is now highlighting 'Worksheets(Worksheets.Count).Name = G' in yellow.

You don't have to change count it is done automatically.
Does it happen for the first sheet to create?
The easiest way would be to send me a file

Here you go. Let me know if you need anything else.

Thank you.

See here your file.
I added an additional column to get the ADVERTISER name shorter
I removed ome sheets for file size issue to download

Thank you! How do I do that quickly on all columns that apply?

Use next code for column C

Sub RemoveEndSpace()
Dim Temp()
Dim I  As Long
    Temp = Range([C6], Range("C" & Rows.Count).End(xlUp))
    For I = 1 To UBound(Temp, 1)
        Temp(I, 1) = RTrim(Temp(I, 1))
    Next I
    [C6].Resize(UBound(Temp, 1)) = Application.Transpose(Temp)
End Sub