XL 2016 Automatiser copier/coller et enregistrer dans fichier texte

Option Explicit
Sub Cree_Txt()
Dim fs As Object, a As Object
Dim Chemin As String, Fichier As String
Dim lig As Long, col As Long
Dim var1 As String

    Application.ScreenUpdating = False
 
    Chemin = "C:\Users\" & Environ("Username") & "\Desktop\"
    Fichier = Sheets("Feuil3").Cells(4, 1) & ".txt"
 
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile(Chemin & "\" & Fichier, True)

    With Sheets("Feuil3")
        For lig = 3 To .Cells(Rows.Count, 1).End(xlUp).Row
                For col = 2 To 6
                    var1 = var1 & .Cells(lig, col) & "         "
                Next col
                a.WriteLine var1: var1 = vbNullString
        Next lig
        a.Close
    End With

    Set a = Nothing: Set fs = Nothing

End Sub