Renommer onglet et feuille lors de l'import

[bouba_95]

Bjr le forum
Suite à l'import d'un fichier texte code ci-dessous.
Je souhaiterai donner le même nom du fichier texte au classeur (onglet+feuille)

Sub Import()
Dim Fichier As Variant
    ChDrive "Y"
    ChDir "Y:\cuba\extraction\"
    Fichier = Application.GetOpenFilename("Fichier Texte(*.txt), *.txt")
    If Fichier <> False Then Lire Fichier
End Sub

Private Sub Lire(ByVal NomFichier As String)
Dim chaine As String
Dim Ar() As String
Dim i As Long
Dim iRow As Long, iCol As Long
Dim NumFichier As Integer
Dim Separateur As String * 1
Dim Debut As Long, Fin As Long

    Separateur = ";"
    Cells.Clear
    Application.ScreenUpdating = False

    Close
    NumFichier = FreeFile

    iRow = 0
    Open NomFichier For Input As #NumFichier
    Do While Not EOF(NumFichier)
        iCol = 1: iRow = iRow + 1
        Line Input #NumFichier, chaine
        Ar = Split(chaine, Separateur)
        For i = LBound(Ar) To UBound(Ar)
            Cells(iRow, iCol) = Ar(1)
            Cells(iRow, iCol + 1) = Ar(2)
            Cells(iRow, iCol + 2) = Ar(3)
            Cells(iRow, iCol + 3) = Ar(4)
        Next i
    Loop
    Close #NumFichier

    Application.ScreenUpdating = True
End Sub