Hi Everyone

I need help from anyone to edit this macro so that it will import 100,000 rows in one sheet then continue importing in another sheet another 100,000 rows and loop till all 3 million lines in my text file is imported into whatever amount of sheets needed in a single workbook.

Sub CommandButton1_Click()
Dim strFilename As String
strFilename = Application.GetOpenFilename _
                    (FileFilter:="Txt File (*.txt), *.txt", _
                    Title:="Select a raw text file to import ")
    If strFilename = "False" Then
        Response = MsgBox("No file was selected", vbOKOnly, "Test")
        Exit Sub
    End If
    ActiveSheet.Cells.ClearContents
    ActiveSheet.Cells.ClearContents
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" + strFilename, _
        Destination:=Range("$B$1"))
        .Name = strFilename
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileOtherDelimiter = "|"
        .TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Rows("1:1").Select
    Selection.AutoFilter
    Cells.Select
    Selection.Columns.AutoFit
    Rows("1:1").RowHeight = 17.25
    Columns("A:A").ColumnWidth = 21.14
    Columns("A:A").ColumnWidth = 13.29
End Sub
Thanks in advance.