Split excel files using vb6.0

Hello Friends,

I used below code for merging excel file from path in visual basic 6.0. Now I'm thinking to split using particular cell reference from the merged excel file in separate sheets ... (like in cell(1,2) this cell column will be the reference & on that base we have to split and paste is it possible friends then plz suggest me) :wave:

Code:

---

Private Sub Command2_Click()

Dim fso As New FileSystemObject
Dim fol As Folder
Dim i, j, k As Long
Dim name1 As String
Fpath = Text1.Text
If Fpath = "" Then
    MsgBox "Please select a path", vbExclamation
Else
    Set fol = fso.GetFolder(Fpath)
    j = fol.Files.Count
    MsgBox " the number of files ur selected for merging is " & j


    Dim xlApp As New Excel.Application
    Dim wbN As Excel.Workbook
    Dim wsN As Excel.Worksheet
    Dim wb  As Excel.Workbook
    Dim ws As Excel.Worksheet
    Dim sNewFullName As String
    'Dim i As Integer

        Set objFiles = fso.GetFolder(Fpath).Files
        Set wbN = xlApp.Workbooks.Add
        Set wsN = wbN.Worksheets(1)
        Set wb = xlApp.Workbooks.Add
        Set ws = wb.Worksheets(1)
        wbN.Activate
        wsN.Activate

        'Hear merging willb happning hear
        For Each objfile In objFiles
            Dim Aad_Row As Long
            Dim Add_Col As Long
            Dim Mrg_Row As Long
            Dim Mrg_Col As Long
            'wsN.Name = "Merged"
            Mrg_Row = 0
            Mrg_Col = 0
            Form2.Caption = objfile.Name
            Mrg_Row = wsN.UsedRange.Rows.Count
            Mrg_Col = wsN.UsedRange.Columns.Count
            Set wb = xlApp.Workbooks.Open(objfile.Path)
            Set ws = wb.Worksheets(1)
                wb.Activate
                ws.Activate
                'Actual Combining process will starts hear
                Aad_Row = ws.UsedRange.Rows.Count
                Add_Col = ws.UsedRange.Columns.Count
                'MsgBox "Number of Rows = " & Aad_Row
                wsN.Range(wsN.Cells(Mrg_Row + 1, 1), wsN.Cells(Mrg_Row + Aad_Row, Add_Col)).NumberFormat = "@"
                wsN.Range(wsN.Cells(Mrg_Row, 1), wsN.Cells(Mrg_Row + Aad_Row, Add_Col)).Value = ws.Range(ws.Cells(1, 1), ws.Cells(Aad_Row + 1, Add_Col)).Value
                'MsgBox "Rows : " & Aad_Row
                wb.Close
        Next
        'For First row comming blank so I Deleted Hear
            'wsN.Range(wsN.Cells(1, 1), wsN.Cells(1, 150)).Delete
        'It is the process of saving
            ccd1.Filter = "Status File (*.xls, *.xlsx)|*.xls;*.xlsx"
            ccd1.ShowSave
            If ccd1.FileName <> "" Then
                wbN.SaveAs (ccd1.FileName)
                MsgBox "Saved Successfully..."
                wbN.Close
                Unload Me
            End If
End If  End Sub

---