Таблица

[1134]

Помогите пожалуйста составить макрос, на сколько я понимаю в нём нет ничего сложного для профессионала (всё обойдётся несколькими строками), а вот у меня многочасовая заминка. Прилагаю файл с исходной табличкой и файл в котором показано, что должно получиться на выходе. Спасибо огромное всем откликнувшимся!

[EducatedFool]

Проверяйте: http://excelvba.ru/XL_Files/Sample__...__18-45-57.zip

Использованы эти функции:
http://excelvba.ru/code/ArrAutofilter
http://excelvba.ru/code/UniqueValues

+ простейший макрос:

Sub Main()
    On Error Resume Next: Application.ScreenUpdating = False
    header = [1:1].Value: Dim sh As Worksheet
    column1 = Range([A2], Range("A" & Rows.Count).End(xlUp)).Value
    arr = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Value
    For Each v In UniqueValues(column1)
        Application.StatusBar = "Создаётся лист " & v
        Set sh = Worksheets.Add: sh.Name = v
        sh.[1:1].Value = header
        newarr = ArrAutofilterEx(arr, "1=" & v)
        sh.Range("a2").Resize(UBound(newarr, 1), UBound(newarr, 2)).Value = newarr
        sh.UsedRange.EntireColumn.AutoFit
    Next
    Application.StatusBar = False
End Sub

[1134]

Огромное спасибо, чётко, ясно оперативно, как всегда!