Вот тебе макрос:  
 
Private Sub Worksheet_Change(ByVal Target As Range)  
   If Target.Address = [e1].Address Then
       Dim cell As Range, ra As Range, newcell As Range  
       Application.ScreenUpdating = False  
       Set ra = kat.Range(kat.[A2], kat.Range("A" & kat.Rows.Count).End(xlUp))
       For Each cell In ra.Cells  
           If Right(cell, 4) = Target Then  
               Set newcell = Range("A" & Rows.Count).End(xlUp).Offset(1)  
               newcell = cell(1, 7): newcell.Next = cell  
           End If  
       Next cell  
   End If  
   Application.ScreenUpdating = True  
End Sub  
 
А вот - пример файла с макросом:  
http://excelvba.ru/XL_Files/Sample__29-09-2009__13-24-05.zip