register313

¦^´_ 1# koala2099

1. Sub NewWb()
   
2.   Set d = CreateObject("Scripting.Dictionary")
   
3.   Application.ScreenUpdating = False
   
4.   Application.DisplayAlerts = False
   
5.   Ar = Sheets("­Ü®w").[A1].CurrentRegion
   
6.   For k = 2 To UBound(Ar)
   
7.       d(Ar(k, 2)) = ""
   
8.   Next
   
9.   For Each dx In d
   
10.       [A1].AutoFilter Field:=2, Criteria1:=dx
    
11.       [A1].CurrentRegion.Copy
    
12.       Workbooks.Add
    
13.       With ActiveWorkbook
    
14.           .ActiveSheet.Paste
    
15.           .ActiveSheet.Name = dx
    
16.           .SaveAs ThisWorkbook.Path & "\" & dx & ".xls"
    
17.           .Close
    
18.       End With
    
19.   Next
    
20.   [A1].AutoFilter
    
21.   Application.DisplayAlerts = True
    
22.   Application.ScreenUpdating = True
    
23.   MsgBox "¤u§@ªí¨Ì±ø¥ó¥t¦s¬¡­¶Ã¯,°õ¦æ§¹²¦!"
    
24. End Sub

½Æ»s¥N½X