GBKEE

¦^´_ 1# user999

1. Option Explicit
   
2. Sub Ex() 'Á`ªí©î¦¨¼Æ­Óexecl : Á`ªí»P¦U¦~¯Å¬¡­¶Ã¯ ¦s¦b¦P¤@­Ó¸ê®Æ§¨
   
3.     Dim wSh As Worksheet, i As Integer, wB As Workbook
   
4.     Application.DisplayAlerts = False
   
5.     Application.ScreenUpdating = False
   
6.     Set wSh = Workbooks("Á`ªí.xlsm").Sheets(1)                             '*** Á`ªí¤w¬O¶}±Òªº ****
   
7.     With wSh
   
8.         .Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True
   
9.         'AÄæ¶i¶¥¿z¿ï  :->  ¨S¦³¿z¿ï·Ç«h(CriteriaRange),¥i¿z¿ï¥X¤£­«ÂЪº¸ê®Æ
   
10.         i = 2
    
11.         .AutoFilterMode = False                                             '¨ú®ø [¦Û°Ê¿z¿ï]
    
12.         Do While .Cells(i, .Columns.Count) <> ""                            'ª½¨ì¨S¸ê®Æ
    
13.             Set wB = Workbooks.Add(1)   '=°Ñ¼Æ:xlWBATWorksheet              '·s¼W¬¡­¶Ã¯(¤@±i¤u§@ªí)
    
14.             .Cells(1).AutoFilter 1, .Cells(i, .Columns.Count)               '[¦Û°Ê¿z¿ï] ²Ä1Äæ ·Ç«h=.Cells(i, .Columns.Count)
    
15.             .Range("A1").CurrentRegion.Copy wB.Sheets(1).[a1]               '[¦Û°Ê¿z¿ï]¨Ì·Ç«h¿z¿ïªº¸ê®Æ ½Æ»s¨ì Á`ªí
    
16.             wB.SaveAs wSh.Parent.Path & "\" & .Cells(i, .Columns.Count) & ".xlsx", FileFormat:=51   '51: ¦sÀɬ° 2007 µL¥¨¶°¬¡­¶Ã¯
    
17.             wB.Close                                                        'Ãö³¬ÀÉ®×
    
18.             i = i + 1                                                       '¤U¤@¦C¸ê®Æ
    
19.         Loop
    
20.         .AutoFilterMode = False
    
21.         .Cells(1, .Columns.Count).EntireColumn = ""                         '¤u§@ªí³Ì«á¤@Äæ:²M°£¿z¿ï¥X¤£­«ÂЪº¸ê®Æ
    
22.      End With
    
23.     Application.DisplayAlerts = True
    
24.     Application.ScreenUpdating = True
    
25. End Sub
    
26. Sub Ex1() '¼Æ­Óexecl µ²¦X¬°Á`ªí:   Á`ªí»P¦U¦~¯Å¬¡­¶Ã¯ ¦s¦b¦P¤@­Ó¸ê®Æ§¨
    
27.     Dim wB As Workbook, wSh As Worksheet, xF As String
    
28.     Application.ScreenUpdating = False
    
29.     Set wSh = Workbooks("Á`ªí.xlsm").Sheets(1)
    
30.     With wSh
    
31.         .Range("a1").CurrentRegion.Offset(1).Clear
    
32.         xF = Dir(wSh.Parent.Path & "\*.xlsx")               '´M§ä wSh.Parent.Path ³o¸ê®Æ§¨ °ÆÀɦW¬°xlsx ªºÀÉ®×
    
33.         Do While xF <> ""
    
34.             With Workbooks.Open(wSh.Parent.Path & "\" & xF).Sheets(1)
    
35.                 .Range("a1").CurrentRegion.Offset(1).Copy wSh.Cells(wSh.Rows.Count, 1).End(xlUp).Offset(1)
    
36.                 .Parent.Close False
    
37.             End With
    
38.             xF = Dir
    
39.         Loop
    
40.         .Range("A1").CurrentRegion.Sort Key1:=.Range("A2"), Order1:=xlAscending, Key2:=.Range( _
    
41.         "B2"), Order2:=xlAscending, Key3:=.Range("C2"), Order3:=xlAscending, _
    
42.         Header:=xlYes, OrderCustom:=1
    
43.         .Parent.Save
    
44.     End With
    
45.     Application.ScreenUpdating = True
    
46. End Sub

½Æ»s¥N½X