How to Split One Excel Sheet into many Sheets According to its Criteria

I want to split one worksheet which has a column named Diameter into many sheets according to the number of diameters found, in my case it is Column C in a Master Sheet, My code is

Private Sub Splitter()
    Dim xl As New Excel.Application
    Dim wb As Excel.Workbook
    Dim Source As Excel.Worksheet
    Dim Destination As Excel.Worksheet
    Dim SourceRow As Long
    Dim Lastrow As Long
    Dim DestinationRow As Long
    Dim Diameter As String
    xl.Application.ScreenUpdating = False
    wb = xl.Workbooks.Open("E:\Patches\Main_Master_VB.xlsm")
    Source = wb.Worksheets("Master")
    Lastrow = Source.Cells(Source.Rows.Count, "C").End(Excel.XlDirection.xlUp).Row
    For SourceRow = 2 To Lastrow
        Diameter = Source.Cells(SourceRow, "C").Value
        Destination = Nothing
        On Error Resume Next
        Destination = wb.Sheets(Diameter)
        On Error GoTo 0
        If Destination Is Nothing Then
            Destination = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
            Destination.Name = Diameter
            Source.Rows(1).Copy(Destination.Rows(1))
        End If
        DestinationRow = Destination.Cells(Destination.Rows.Count, "C").End(Excel.XlDirection.xlUp).Row + 1
        Source.Rows(SourceRow).Copy(Destination:=Destination.Rows(DestinationRow))
    Next SourceRow
    xl.Application.ScreenUpdating = True
End Sub

I receive error Invalid index. (Exception from HRESULT: 0x8002000B (DISP_E_BADINDEX))' at the Line Destination = wb.Sheets(Diameter)

Notice : this code is running with VBA but not running with VB.net

Appreciate your help

Thanks, Regards

Moheb Labib

The following code fixes compilation errors caused by Option Strict disliking late binding. It may help point our what is wrong with the code.

Imports Microsoft.Office.Interop.Excel
Imports Microsoft.Office.Interop

Private Sub Splitter()
    Dim xl As New Excel.Application
    Dim wb As Excel.Workbook
    Dim Source As Excel.Worksheet
    Dim Destination As Excel.Worksheet
    Dim SourceRow As Long
    Dim Lastrow As Long
    Dim DestinationRow As Long
    Dim Diameter As String
    xl.Application.ScreenUpdating = False
    wb = xl.Workbooks.Open("E:\Patches\Main_Master_VB.xlsm")
    Source = CType(wb.Worksheets("Master"), Worksheet)
    Dim RowCount = Source.Rows.Count
    Dim LastRowRange = CType(Source.Cells(RowCount, "C"), Range)
    Lastrow = LastRowRange.End(Excel.XlDirection.xlUp).Row
    For SourceRow = 2 To Lastrow
        Dim DiameterRange = CType(Source.Cells(SourceRow, "C"), Range)
        Diameter = DiameterRange.Value.ToString
        Destination = Nothing
        'On Error Resume Next
        Destination = CType(wb.Sheets(Diameter), Worksheet)
        'On Error GoTo 0
        If Destination Is Nothing Then
            '                   (Before, After, Count, Type)
            Destination = CType(wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count)), Worksheet)
            Destination.Name = Diameter
            Dim row = CType(Source.Rows(1), Range)
            row.Copy(Destination.Rows(1))
        End If
        Dim DestinationRowRange = CType(Destination.Cells(Destination.Rows.Count, "C"), Range)
        DestinationRow = DestinationRowRange.End(Excel.XlDirection.xlUp).Row + 1
        Dim SourceRowRange = CType(Source.Rows(SourceRow), Range)
        SourceRowRange.Copy(Destination:=Destination.Rows(DestinationRow))
    Next SourceRow
    xl.Application.ScreenUpdating = True
End Sub