Conversion en .csv

Option Explicit
'UTF-8
Public Sub Create_CSV()
Dim wb As Workbook, ws As Worksheet, ws2 As Worksheet
Dim rngHeaders As Range, rngData As Range
Dim sPath As String, sFile As String
Dim lastCol As Long, lastRow As Long, lRow As Long, Counter As Long
Dim i As Long
Const X As Long = 1500

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
        
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Données")
    sPath = wb.Path & Application.PathSeparator
    
    With ws
        lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set rngHeaders = .Cells(1).Resize(, lastCol)
        Counter = WorksheetFunction.RoundUp(lastRow / X, 0)
        lRow = 2
        For i = 1 To Counter
            Set rngData = Union(rngHeaders, .Cells(lRow, 1).Resize(X - 1, lastCol))
            sFile = "Part_" & i & ".csv"
            Set ws2 = Worksheets.Add
            rngData.Copy Destination:=ws2.Cells(1)
            ws2.Copy
            With ActiveWorkbook
                .SaveAs Filename:=sPath & sFile, FileFormat:=xlCSV
                .Close savechanges:=False
            End With
            Application.DisplayAlerts = False
            ws2.Delete
            Application.DisplayAlerts = True
            lRow = lRow + (X - 1)
        Next i
    End With
    
End Sub