Какое максимальное количество отделов для одного заказа?  
Если 1-3, то формулай можно, если больше - лучше не заморачиваться.

естественно...в этом-то и проблема...

Афтор! номер отделов выводить через запятую? или каждый отдел в отдельную ячейку правее номера заказа?

{quote}{login=Ezoptron}{date=25.03.2010 04:38}{thema=}{post}просто подумал, что может кто-нить формулу магическую знает, а с макросом эт справлюсь :){/post}{/quote}  
Виктор знает такую формулу но не более трех отделов на закакз .

не шибко оптимально, но работает  
 
Sub pp()  
Application.ScreenUpdating = False  
   Dim i As Long, j As Long  
   Dim iL As Long, iL2 As Long, iC As Long, k As Long  
   Dim sh1 As Worksheet  
   Dim sh2 As Worksheet  
   Dim uniq As New Collection  
   Dim rrange As Range  
   Dim cell As Range  
   Set sh1 = Sheets("Лист1")  
   Set sh2 = Sheets("лист2")  
   iL = sh1.Cells(Rows.Count, 1).End(xlUp).Row  
   iL2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row  
   For i = 2 To iL2  
       sh1.Range("a1:b" & iL).AutoFilter field:=1, Criteria1:=sh2.Cells(i, 1)  
       Set rrange = sh1.Range("b2:b" & iL).SpecialCells(xlCellTypeVisible)  
       On Error Resume Next  
       For Each cell In rrange  
           uniq.Add cell.Text, CStr(cell)  
       Next cell  
       sh1.ShowAllData  
       k = 2  
       For j = uniq.Count To 1 Step -1  
           sh2.Cells(i, k) = uniq(j)  
           uniq.Remove (j)  
           k = k + 1  
       Next j  
   Next i  
Application.ScreenUpdating = True  
End Sub