Hsieh

¦^´_ 1# fangsc

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. With Sheet1
   
4.   For Each a In .Range(.[C2], .[C2].End(xlDown))
   
5.     If d.exists(a.Value) = False Then
   
6.        d(a.Value) = a.Address
   
7.        Else
   
8.        d(a.Value) = d(a.Value) & "," & a.Address
   
9.     End If
   
10.   Next
    
11. For Each ky In d.keys
    
12.    Sheets(ky).UsedRange.Offset(1).ClearContents
    
13.   .Range(d(ky)).EntireRow.Copy Sheets(ky).[A2]
    
14. Next
    
15. End With
    
16. End Sub

½Æ»s¥N½X