Bonjour,
Une solution pour ne choisir qu'une fois le nom et l'emplacement pour les fichiers.csv
Le nom choisi sera renommé et incrémenté "01_", "02_", etc.
Un essai ...
Option Explicit
Sub ExportCSV()
Dim Fd As FileDialog
Dim strChaine As String, StrEntete As String
Dim Plage As Range
Dim Ligne As Long
Dim Colonne As Integer
Dim Dcol As Integer
Dim X As Integer, Z As Byte
Dim NomFich As String
Dim LeCsv As String
Dim FichSelect As Variant
Dcol = Cells(1, Columns.Count).End(xlToLeft).Column ' dernière colonne
''' Entêtes de la plage à transformer en CSV
Set Plage = Range(Cells(1, "A"), Cells(1, Dcol)) ' sélection des entêtes
''' mémorise les entêtes (ligne 1)
For Colonne = 1 To Plage.Columns.Count ' boucle sur les colonnes
If StrEntete <> "" Then StrEntete = StrEntete & ";"
StrEntete = StrEntete & Plage.Cells(1, Colonne).Value
Next Colonne
Z = 0
''' Fenêtre de choix d'emplacement et nom du fichier en sortie (nom temporaire)
Set Fd = Application.FileDialog(msoFileDialogSaveAs)
''' Ajout du filtre
Fd.FilterIndex = 5
''' Sortie si pas de fichier
If Fd.Show = False Then Exit Sub
''' Ouverture du fichier de sortie
Open Fd.SelectedItems(1) For Output As #1
With Fd ' ce bloc extrait le nom du fichier choisi afin de l'incrémenter
For Each FichSelect In .SelectedItems
LeCsv = Right(FichSelect, Len(FichSelect) - InStrRev(FichSelect, "\"))
NomFich = FichSelect
Next FichSelect
End With
Close #1 ' ferme le fichier choisi
''' ############# 3 premiers blocs
For X = 2 To 4500 Step 1500 ' boucle sur les blocs de 1500 lignes
Z = Z + 1
''' rouvre le fichier choisi
Open Fd.SelectedItems(1) For Output As #1
''' ajoute les entêtes au fichier choisi
Print #1, StrEntete
For Ligne = X To X + 1499 ' boucle sur les blocs de 1500 lignes
For Colonne = 1 To Plage.Columns.Count
If strChaine <> "" Then strChaine = strChaine & ";"
strChaine = strChaine & Plage.Cells(Ligne, Colonne).Value
Next Colonne
Print #1, strChaine ' ajoute les données au fichier choisi
strChaine = ""
Next Ligne
''' Fermeture du fichier
Close #1
''' renomme le fichier
FileCopy NomFich, "0" & Z & "_" & LeCsv
MsgBox "Fichier : " & "0" & Z & "_" & LeCsv & " disponible. "
Next X ' prochain bloc
''''' ################### dernier bloc > 4501 to 5000
''' Ouverture du fichier de sortie
Open NomFich For Output As #1
Print #1, StrEntete ' ajoute les entêtes
For Ligne = 4501 To 5001 ' boucle sur les 500 dernières lignes
For Colonne = 1 To Plage.Columns.Count
If strChaine <> "" Then strChaine = strChaine & ";"
strChaine = strChaine & Plage.Cells(Ligne, Colonne).Value
Next Colonne
Print #1, strChaine ' ajoute les données
strChaine = ""
Next Ligne
''' Fermeture du fichier
Close #1
''' renomme le fichier choisi
FileCopy NomFich, "0" & Z + 1 & "_" & LeCsv
MsgBox "Fichier : " & "0" & Z + 1 & "_" & LeCsv & " disponible. "
''' supprime le fichier temporaire
Kill NomFich
End Sub
ric