Hi Ramakrishnan,

Try this. Thanks to Ron Debruin

In a standard module

Code:
Public rsCon        As Object
Public rsData       As Object

Dim arrFields()     As String
Dim blnFieldStored  As Boolean

Public Sub GetData(SourceFile As Variant, SourceSheet As String, SourceRange As String, _
                    Header As Boolean, UseHeaderRow As Boolean, Fname As String)
    
    'Original code: Ron Debruin
    ' 30-Dec-2007, working in Excel 2000-2007
    Dim szConnect   As String
    Dim szSQL       As String
    Dim lCount      As Long
    Dim wbkActive   As Workbook
    Dim wbkNew      As Workbook
    
    Set wbkActive = ThisWorkbook
    
    ' Create the connection string.
    If Header = False Then
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
        End If
    Else
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=Yes"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=Yes"";"
        End If
    End If

    If SourceSheet = "" Then
        ' workbook level name
        szSQL = "SELECT * FROM " & SourceRange$ & ";"
    Else
        ' worksheet level name or range
        szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
    End If

    On Error GoTo SomethingWrong

    If rsCon Is Nothing Then
        Set rsCon = CreateObject("ADODB.Connection")
        Set rsData = CreateObject("ADODB.Recordset")
    End If
    
    If Not rsCon.State = 1 Then rsCon.Open szConnect
    
    If rsData.State = 1 Then rsData.Close
    rsData.Open szSQL, rsCon, 0, 1, 1

    ' Check to make sure we received data and copy the data
    If Not rsData.EOF Then
        Set wbkNew = Workbooks.Add
        If Not blnFieldStored Then
            For i = 1 To rsData.Fields.Count
                ReDim Preserve arrFields(1 To i)
                arrFields(i) = rsData.Fields(i - 1).Name
            Next
            blnFieldStored = True
        End If
    
        'Add the header cell in each column if the last argument is True
        With wbkNew.Worksheets(1)
            .Cells(1, 1).Resize(, UBound(arrFields)) = arrFields
            .Cells(2, 1).CopyFromRecordset rsData
        End With
                
        wbkNew.SaveAs ThisWorkbook.Path & "\" & Fname, 51
        wbkNew.Close
        Set wbkNew = Nothing
    Else
        MsgBox "No records returned from : " & SourceFile, vbCritical
    End If
    
    ' Clean up
    Set wbkActive = Nothing
    Exit Sub

SomethingWrong:
    MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
           vbExclamation, "Error"
    On Error GoTo 0

End Sub
Again in a standard module. (Better in a new module)

Code:
Sub kTest()
    
    Dim i               As Long
    Dim Fname           As String
    Dim n               As Long
    
    Const NewWbkRows    As Long = 40000     '<<==== adjust this rows
    Const TotalRows     As Long = 300000    '<<==== adjust this rows
    
    Const SourceFile    As String = "D:\Temp\Sample.xlsx" '<<==== adjust to suit
    
    
    For i = 1 To TotalRows Step NewWbkRows
        n = n + 1
        If i = 1 Then
            GetData SourceFile, "Sheet1", _
                "A" & i & ":H" & i + NewWbkRows - 1, True, True, "NewFile" & n
        Else
            GetData SourceFile, "Sheet1", _
                "A" & i & ":H" & i + NewWbkRows - 1, True, False, "NewFile" & n
        End If
    Next
    
    If rsData.State = 1 Then rsData.Close
    Set rsData = Nothing
    If rsCon.State = 1 Then rsCon.Close
    Set rsCon = Nothing

End Sub
Adjust the rows and file path.