想拆分單獨一個sheet頁,按行來拆分為多個sheet頁,可以使用以下代碼:
Sub spitsheet()
Set d = CreateObject("scripting.dictionary")
With Worksheets(1)
rrow = .Cells(Rows.Count, "a").End(3).Row
For i = 1 To rrow 'spit from 1 row 從第幾行開始
strr = .Range("B" & i).Value 'split b coloum 取哪個作爲sheet name 和拆分依據
If Not d.exists(strr) Then
d.Add strr, .Range("a" & i).Resize(1, 6) '拆分行,包含哪些列
Else
Set d.Item(strr) = Union(d.Item(strr), .Range("a" & i).Resize(1, 6))'拆分行,包含哪些列
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
拆分后,點擊綠色三角形 拆分結果