VSTO-VB.net-拆分工作表为工作簿

DisAppSet(False)
                Dim Actwb As Excel.Workbook = xlapp.ActiveWorkbook

                Dim ActSht As Excel.Worksheet = xlapp.ActiveSheet

                Dim SavePathStr As String = Actwb.Path + "\拆分结果\"

                Dim shtName As String = "射雕英雄传0"

                'If ActSht.Name <> shtName Then MsgBox("要打开指定工作表")

                Dim Mydic As New Dictionary(Of String, Excel.Range)

                Dim TitleRange As Excel.Range

                With ActSht

                    TitleRange = .Rows("1:4")

                    For index As Integer = 5 To 170

                        Dim ts As String = .Cells(index, 2).value.ToString()

                        'MsgBox(index.ToString())

                        If Mydic.ContainsKey(ts) Then

                            Mydic(ts) = xlapp.Union(Mydic(ts), .Rows(index))

                        Else

                            Mydic.Add(ts, .Rows(index))

                        End If

                    Next

                End With

                'MsgBox(Mydic.Count.ToString() + "--" + Mydic("神雕侠侣").Count.ToString())

                'Dim addwb As Excel.Worksheet = Actwb.Worksheets.Add()

                'Mydic("神雕侠侣").Copy(addwb.Cells(1, 1))

                'Mydic("神雕侠侣").EntireRow.Delete()

                For Each key In Mydic.Keys

                    'Actwb.Sheets.Add(After:=Actwb.Sheets(Actwb.Sheets.Count))

                    'ActSht.Copy()

                    Dim addwb As Excel.Worksheet = Actwb.Worksheets.Add()

                    With addwb

                        TitleRange.Copy(.Range("A1"))

                        Mydic(key).Copy()

                        .Range("A5").PasteSpecial(Paste:=Excel.XlPasteType.xlPasteAll)

                        .Name = key

                        .Move()

                    End With

                    xlapp.ActiveWorkbook.SaveAs(Filename:=SavePathStr + key)

                    xlapp.ActiveWorkbook.Close()

                Next

                DisAppSet(True)

                MsgBox("完成")