­ã´£³¡ªL

Sub test()
Dim Sht As Worksheet, xD, xR As Range
Set xD = CreateObject("Scripting.Dictionary")
xD("") = 1
With Sheets("·JÁ`©ú²Ó").UsedRange
¡@¡@For Each xR In .Columns(2).Offset(1, 0).Cells
¡@¡@¡@¡@If xD(xR.Value) = "" Then
¡@¡@¡@¡@¡@On Error Resume Next
¡@¡@¡@¡@¡@Set Sht = Sheets(xR.Value)
¡@¡@¡@¡@¡@On Error GoTo 0
¡@¡@¡@¡@¡@If Sht Is Nothing Then Sheets.Add(after:=Sheets(Sheets.Count)).Name = xR.Value
¡@¡@¡@¡@¡@.AutoFilter Field:=2, Criteria1:=xR.Value
¡@¡@¡@¡@¡@.Columns("a:d").Copy Sheets(xR.Value).[a1]
¡@¡@¡@¡@¡@xD(xR.Value) = 1: Set Sht = Nothing
¡@¡@¡@¡@End If
¡@¡@Next
¡@¡@Application.Goto .Item(1)
End With
Sheets("·JÁ`©ú²Ó").AutoFilterMode = False
End Sub
¡@