Læs textfil til Excel

Hej

Det jeg skal bruge er at den skal tage 65536 linjer, og smide dem ind i excel, når den har smidt dem ind skal den starte på nyt ark. Hvor den smider de næste 65536 ind.

  Dim i, ObjExcel, ObjWorkbook, oActive
        Dim Filnavn As String
        OpenFileDialog1.ShowDialog()

        Filnavn = OpenFileDialog1.FileName

        ObjExcel = CreateObject("EXCEL.APPLICATION")
        ObjWorkbook = ObjExcel.Workbooks.add()
        oActive = ObjWorkbook.ActiveSheet

        If My.Computer.FileSystem.FileExists(Filnavn) Then
            Dim sr As New System.IO.StreamReader(Filnavn)

            i = 1
            ObjExcel.Visible = True
            Dim AntalSheets
            AntalSheets = 1
   

            Do While sr.Peek >= 0
                If i = 65537 Then
                    AntalSheets = AntalSheets + 1
                    ObjWorkbook.Sheets.add()
                    ObjWorkbook.sheets("Ark" & AntalSheets).Select()
                    i = 1
                End If
                ObjWorkbook.ActiveSheet.Cells(i, 1) = sr.ReadLine
                i = i + 1
            Loop

            sr.Close()

Sådan her ser min kode ud, sådan som det er nu.

Den virker, men det går meget langsomt. Er der nogen måde jeg kan gøre den hurtigere?