Macro Copiar a otra hoja según valor de Celda

H o l a:

Te anexo la macro para copiar cada marca en una hoja nueva.

Sub Macro1()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set h1 = Sheets("Datos")
    For Each h In Sheets
        Select Case h.Name
            Case h1.Name
            Case Else
                h.Delete
        End Select
    Next
    '
    h1.Columns("D").Copy h1.Range("Z1")
    u = h1.Range("Z" & Rows.Count).End(xlUp).Row
    h1.Range("Z1:Z" & u).RemoveDuplicates Columns:=1, Header:=xlYes
    u2 = h1.Range("Z" & Rows.Count).End(xlUp).Row
    For i = 2 To u2
        Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
        h1.Range("A1:H" & u).AdvancedFilter Action:=xlFilterCopy, _
                CriteriaRange:=h1.Range("Z1:Z2"), CopyToRange:=h2.Range("A1"), Unique:=False
        h1.Range("Z2").Delete Shift:=xlUp
    Next
    h1.Range("Z:Z").Clear
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

En cuanto a la variante del código para copiar solamente algunas columnas, tendría que trabajarlo. Crea una nueva pregunta para esa parte y te envío el código actualizado.

' : )
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
' : )

Estupendo Dam, sólo un pequeño detalle que se me había pasado, las hojas han de tener el nombre de cada marca

Te anexo la macro actualizada

Sub Macro1()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set h1 = Sheets("Datos")
    For Each h In Sheets
        Select Case h.Name
            Case h1.Name
            Case Else
                h.Delete
        End Select
    Next
    '
    h1.Columns("D").Copy h1.Range("Z1")
    u = h1.Range("Z" & Rows.Count).End(xlUp).Row
    h1.Range("Z1:Z" & u).RemoveDuplicates Columns:=1, Header:=xlYes
    u2 = h1.Range("Z" & Rows.Count).End(xlUp).Row
    For i = 2 To u2
        Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
        h2.Name = h1.Range("Z2")
        h1.Range("A1:H" & u).AdvancedFilter Action:=xlFilterCopy, _
                CriteriaRange:=h1.Range("Z1:Z2"), CopyToRange:=h2.Range("A1"), Unique:=False
        h1.Range("Z2").Delete Shift:=xlUp
    Next
    h1.Range("Z:Z").Clear
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

' : )
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
' : )

Al final de mi respuesta hay 2 valoraciones, "Votar" y "Excelente", si todavía tienes dudas puedes solicitar más información, si la respuesta cumple con lo primero que solicitaste, esperaría que cambiaras la valoración.