Sub 拆分工作簿为多个sheet()
Set d = CreateObject("scripting.dictionary")
With Worksheets(1)
rrow = .Cells(Rows.Count, "a").End(3).Row
For i = 2 To rrow '从第2行开始拆分
strr = .Range("B" & i).Value '拆分B列内容
If Not d.exists(strr) Then
d.Add strr, .Range("a" & i).Resize(1, 10)
Else
Set d.Item(strr) = Union(d.Item(strr), .Range("a" & i).Resize(1, 10))
End If
Next
k = d.keys
i = d.items
For a = 0 To d.Count - 1
Worksheets.Add.Name = k(a)
i(a).Copy Worksheets(k(a)).Range("a2")
Next
End With
End Sub