ikboy

try this:

1. Sub zz()
   
2. Dim ar, b(), d As Object, f, k, t
   
3. Set d = CreateObject("scripting.dictionary")
   
4. ar = Sheets(1).[b1048576].End(3).CurrentRegion.Value
   
5. For i = 1 To UBound(ar)
   
6.     d(ar(i, 1)) = ""
   
7. Next
   
8. f = Application.GetOpenFilename
   
9. If f = "Fasle" Or f = "" Then Exit Sub
   
10. Application.ScreenUpdating = 0
    
11. Workbooks.Open Filename:=f, Password:="122333"
    
12. ar = Sheets(1).[b1048576].End(3).CurrentRegion.Value
    
13. ReDim b(UBound(ar, 2) - 1)
    
14. ActiveWorkbook.Close 0
    
15. For i = 1 To UBound(ar)
    
16.     If d.exists(ar(i, 1)) Then
    
17.         For j = 1 To UBound(ar, 2)
    
18.             b(j - 1) = ar(i, j)
    
19.         Next
    
20.         d(ar(i, 1)) = b
    
21.     End If
    
22. Next
    
23. t = d.items
    
24. Sheets(1).[b1].End(4).Select
    
25. Sheets(1).[b1].End(4).Resize(d.Count, UBound(ar, 2)) = Application.Transpose(Application.Transpose(t))
    
26. Application.ScreenUpdating = 1
    
27. End Sub

½Æ»s¥N½X