拆分excel表為幾個sheet code

想拆分單獨一個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

拆分后，點擊綠色三角形 拆分結果