Diviser un fichier en fichier de 1000 lignes avec un nom différent

Le code suivant ouvre le fichier FICHTEST en mode de lecture séquentielle.

Open "FICHTEST" For Input As #1
' Ferme le fichier avant de l'ouvrir à nouveau dans un autre mode.
Close #1

Sub Dispatche_Fichier_CSV_En_N_Fichiers()
Close
'Mettre ce fichier et le fichier .Csv dans le même dossier

'Possibilité de mettre un Inputbox en copiant collant de l'explorateur le nom du fichier (F2)
NomFich = "ARR3000" ' Inputbox("Nom du fichier (sans le .csv)?")

'Nombre de lignes pour la découpe
NombreLigneCoupe = 1000

N = 1 'Compteur Fichier N
Open ThisWorkbook.Path & "\" & NomFich & ".csv" For Input As #1

i = 0 'Compteur ligne

Open ThisWorkbook.Path & "\" & NomFich & "N" & N & ".csv" For Output As #2
'Recherche Entête
 Line Input #1, a$
 Entête = a$
 Print #2, Entête
 
Do While Not (EOF(1))
 i = i + 1
 Line Input #1, a$
 'MsgBox a$
 Print #2, a$
 If i = NombreLigneCoupe Then Close #2: i = 0: N = N + 1: Open ThisWorkbook.Path & "\" & NomFich & "N" & N & ".csv" For Output As #2: Print #2, Entête
Loop

'Ferme tous les fichiers textes
Close

'si il y a un nombre d'enregistrement de  3000 (ou 2000, 4000 ...), on doit supprimer
'le dernier fichier qui n'aura que l'Entête dans le fichier
If i = 0 Then Kill ThisWorkbook.Path & "\" & NomFich & "N" & N & ".csv"
End Sub