Hsieh

¦^´_ 2# hugh0620

¤u§@ªí¸s²Õ½Æ»s

1. Sub nn()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. With Sheet1
   
4. For Each A In .Range(.[B5], .[B5].End(xlDown))
   
5.   d(A.Value) = IIf(d(A.Value) = "", A.Offset(, 1), d(A.Value) & "," & A.Offset(, 1))
   
6. Next
   
7. For Each ky In d.keys
   
8.   Sheets(Split(d(ky), ",")).Copy
   
9.   With ActiveWorkbook
   
10.      .SaveAs "D:\" & ky & ".xls"
    
11.      .Close 1
    
12.   End With
    
13. Next
    
14. End With
    
15. End Sub

½Æ»s¥N½X