How to convert code from vba to vb to split sheet into multiple sheets

[jtammyg]

Hi!

I'm trying to split a sheet into multiple sheets by using VB 2010 and Excel. I found the following code, but don't know how to convert it to VB from VBA.

Can someone please shed some light please?

The code works super fast in VBA and would be great for my VB form.

Thanks in advanced.

Tammy

Const sname As String = "Temp" 'change to whatever starting sheet
Const s As String = "A" 'change to whatever criterion column
Dim d As Object, a, cc&
Dim p&, i&, rws&, cls&
Set d = CreateObject("scripting.dictionary")
With Sheets(sname)
    rws = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
    cls = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
    cc = .Columns(s).Column
End With
For Each sh In Worksheets
    d(sh.Name) = 1
Next sh


Application.ScreenUpdating = False
With Sheets.Add(after:=Sheets(sname))
Sheets(sname).Cells(1).Resize(rws, cls).Copy .Cells(1)
.Cells(1).Resize(rws, cls).Sort .Cells(cc), 2, Header:=xlYes
a = .Cells(cc).Resize(rws + 1, 1)
p = 2
For i = 2 To rws + 1
    If a(i, 1) <> a(p, 1) Then
        If d(a(p, 1)) <> 1 Then
            Sheets.Add.Name = a(p, 1)
            .Cells(1).Resize(, cls).Copy Cells(1)
            .Cells(p, 1).Resize(i - p, cls).Copy Cells(2, 1)
        End If
        p = i
    End If
Next i
Application.DisplayAlerts = False
    .Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End With
Sheets(sname).Activate

 

[Herman]

Here, try this. This is not the same code but it should let you do whatever you need to do. This uses the clipboard functionalities in the Excel interop to copy and paste ranges. You will need to add a reference to the Microsoft.Office.Interop.Excel .NET assembly to your project.

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        ' Get a reference to the Excel interop and open a workbook.
        Dim xl As New Application
        Dim wb As Workbook = xl.Workbooks.Open(xl.GetOpenFilename("Excel Workbooks (*.xls; *.xlsx),*.xls;*.xlsx").ToString)

        ' Copy columns B and C from Sheet1 and paste them into Sheet2 at position A1, overwriting whatever was in there.
        If XlsCopyPaste(wb, "Sheet1", "B:C", "Sheet2", "A1", XlPasteType.xlPasteAll) Then
            ' If it worked save the workbook.
            wb.Save()
        End If

        ' Don't forget to close the workbook and the application when you are done or
        ' it will leave an instance of Excel running in the background for each time you run your code.
        wb.Close()
        xl.Quit()

    End Sub

    Public Function XlsCopyPaste(ByRef wb As Workbook,
                                 ByVal srcSheetName As String, ByVal srcRange As String,
                                 ByVal tgtSheetName As String, ByVal tgtRange As String,
                                 ByVal pasteType As XlPasteType) As Boolean
        Try
            ' Cast the worksheets in the workbook into a list so it's easier to work
            ' with than the 1-indexed collection the Excel Interop exports.
            Dim lstWorksheets = wb.Sheets.Cast(Of Worksheet).ToList

            ' Acquire a reference to the source worksheet by name
            Dim srcSheet As Worksheet = lstWorksheets.Where(Function(ws) ws.Name = srcSheetName).FirstOrDefault
            If srcSheet IsNot Nothing Then
                ' If the source sheet exists get the target sheet.
                Dim tgtSheet As Worksheet = lstWorksheets.Where(Function(ws) ws.Name = tgtSheetName).FirstOrDefault
                If tgtSheet Is Nothing Then
                    ' If the target sheet does not exist create and name it.
                    tgtSheet = wb.Sheets.Add()
                    tgtSheet.Name = tgtSheetName
                End If

                ' Source and target areas on the worksheets
                Dim source = srcSheet.Range(srcRange)
                Dim target = tgtSheet.Range(tgtRange)

                ' Cut from the source and paste into the target.
                source.Copy()
                target.PasteSpecial(pasteType, XlPasteSpecialOperation.xlPasteSpecialOperationNone, False, False)
            End If
        Catch ex As Runtime.InteropServices.COMException
            ' If anything goes wrong with the excel interop ignore it and return false.
            Return False
        End Try

        Return True
    End Function