ERREUR l'entrée dépasse la fin du fichier

Sub ImportCSV()
 Application.ScreenUpdating = False
    Dim laChaine As String, x, fichier As String, texte, i As Long, sh As Long, lig As Long 'variable necessaire
    Dim J As Long
    Dim l As Integer
    Dim k As Integer
    Dim DerCol As Integer
    Dim f1 As Worksheet
    Dim p As Integer
    Dim LeNom As String
    Dim sht As Worksheet
    Dim Mois As String
    
    Application.ScreenUpdating = False

   
    ' partie 1
   ' ouverture de la boite de dialog fichier
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False ' on choisi q'un seul fichier
        If .Show = True Then 'si on annule pas
            fichier = .SelectedItems(1) 'fichier sera l'item choisi dans la boite de dialog
            LeNom = Mid(fichier, InStrRev(fichier, "\") + 1)  ' extraction du nom par ric
            LeNom = Left(LeNom, (Len(LeNom) - 4))
        Else
            MsgBox "Annuler" ' sinon un message
            Exit Sub 'sortie de sub si annuler
        End If
    End With
    'partie 2
    ' lecture et enregistrement du csv dans la variable
    x = FreeFile
    Open fichier For Input As #x  'ouverture du fichier en mémoire(non apparent)
    laChaine = Input(LOF(x), #x) 'placement du texte complet dans la variable "lachaine"
    Close #x ' fermeture du fichier
    'partie 3
    'exploitation du csv
    sh = 2   ' on demarre au 2 eme sheets le premier étant l'accueil chez moi
    texte = Split(laChaine, vbCrLf)  ' on coupe le texte par les saut de ligne
    For i = 0 To UBound(texte)
        lig = lig + 1    'on increment le n° de ligne
        With Sheets(sh)
               .Name = LeNom  ' on nomme le sheets
            .Cells(lig, 1) = texte(i)    'on met la ligne entiere dansla cellule la ligne complete meme avec  les pointvirgules
            If lig = Rows.Count - 2 Or i = UBound(texte) Then    ' si on arrive en bas du sheets ou au bout des lignes du csv alors
                'on applique la fonction native |||textTocolumns||| par les point virgules
                .Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False
                'DataType:=OtherChar, OtherChar:=";",TextQualifier:=xlDoubleQuote, Space:=True
                sh = sh + 1: lig = 0 'on increment l'index de sheets

                If Sheets.Count < sh Then Sheets.Add After:=Sheets(Sheets.Count) 'au cas ou il n'y aurait pas le sheets (sh) on l'ajoute
            End If
        End With
    Next
sub end