Hsieh

¦^´_ 1# tony0318

1. Sub ex()
   
2. Dim A As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. With Sheet1
   
5. For Each A In .Range(.[C2], .[C65536].End(xlUp))
   
6.   If IsEmpty(d(A & "")) Then
   
7.   Set d(A & "") = Union([A1:L1], A.Offset(, -2).Resize(, 12))
   
8.   Else
   
9.   Set d(A & "") = Union(d(A & ""), A.Offset(, -2).Resize(, 12))
   
10.   End If
    
11. Next
    
12. For Each ky In d.keys
    
13.    With Sheets.Add(after:=Sheets(Sheets.Count))
    
14.    .Name = ky
    
15.    d(ky).Copy .[A1]
    
16.    End With
    
17. Next
    
18. End With
    
19. End Sub

½Æ»s¥N½X