необходимо разбить 1 лист с данными на несколько файлов по критерию из колонки

[Yalenka]

Добрый день,

У меня есть база данных сотрудников, на 2000 человек, у каждого сотрудника назначен супервизор (около 700 человек) в отдельной колонке.
Задача с помощью экселя 2003 сделать каждому супервизору отдельный файл с его людьми.
пример прикреплен в раре, эксель не крепился..
dummy file - пример базы
ivanov - пример результата
Помогите пожалуйста, мне подсказали что можно макросом быстро расделить, но я еще ими не овладела
заранее спасибо!

[OlegVE]

Здравствуйте

Сообщение от Yalenka

...У меня есть база данных сотрудников...
Задача с помощью экселя 2003 сделать каждому супервизору отдельный файл с его людьми...

1. База данных у Вас в Excel?
2. У Вас это одноразовая работа или ведётся изо дня в день?
Необходим ответы на вопросы, потому предварительный: Может просто сначала отсортировать в Excel по колонке "Direct Sup Name", а потом уже говорить как разбить вашу "базу" на 700 файлов
До свидания

[Yalenka]

OlegVe, спасибо за вопросы,
да, база в Эксель.
такая работа делается первый раз сейчас, а потом будет повторяться с периодичностью в 3 месяца. поэтому ищу вариант оптимизации.
а зачем сортировать по имени супервизора?

[OlegVE]

Сообщение от Yalenka

а зачем сортировать по имени супервизора?

Для упрощения обработки в цикле (если его использовать). Пробую сейчас по другому, без сортировки.
Неужели нужно 700 файлов!?

[The_Prist]

Вот это не подойдет?

[Yalenka]

звучит страшно, но да, иначе мне придется ручками каждому копи-пастить..
а так я файлы сложу в одной папке и разошлю вместе с коллегой.

ох, все равно бредово выглядит.. надо наверное еще побрейнстрормить...

[Hugo121]

Освоил для меня новое - массивы как Item словаря.
Хорошая штука.
Вроде всё работает, как надо:

Option Explicit
Option Compare Text

Sub Otbor()
    Dim a(), oDict As Object, i As Long, temp As String, rr As Range
    Dim x As Byte, kk
    
    With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
        
    Set rr = ThisWorkbook.Sheets(1).[a1:k1]
    
    a = Range("A2:K" & Range("A" & Rows.Count).End(xlUp).Row).Value

    Set oDict = CreateObject("Scripting.Dictionary")
    
    For i = 1 To UBound(a)
        temp = Trim(a(i, 11))
        If Not oDict.Exists(temp) Then
            ReDim b(1 To UBound(a), 1 To 12)
            b(1, 12) = 1
            For x = 1 To 11: b(1, x) = a(i, x): Next
            oDict.Add temp, b
        Else
        b = oDict.Item(temp)
            b(1, 12) = b(1, 12) + 1
            For x = 1 To 11: b(b(1, 12), x) = a(i, x): Next
            oDict.Item(temp) = b
        End If
    Next

    

    For Each kk In oDict.keys
    
    With Workbooks.Add
    rr.Copy .Worksheets(1).[a1]
        .Worksheets(1).Name = kk
        .Worksheets(1).Range("A2:K2").Resize(oDict.Item(kk)(1, 12)) = oDict.Item(kk)
        .SaveAs ThisWorkbook.Path & "\" & kk
        .Close 0
    End With
    
    Next

    .DisplayAlerts = True
    .ScreenUpdating = True
    End With
End Sub

[OlegVE]

Yalenka, извините, я на работе. Задача меня заинтересовала. Загляните завтра. Но предварительно ответьте на вопрос исходя из следующего

а так я файлы сложу в одной папке и разошлю вместе с коллегой.

. Какова всё-таки конечная цель? Может можно/нужно рассылать по e-mail, не создавая 700 файлов, а создав, опять-же, 700 e-mail (может можно/нужно сгруппировать для супер-супервизора, визора над суперами)