Ll faut juste cocher "microsoft scripting runtime" dans le menu outils / références dans VBA
ensuite dans un module tu colles tout ce qui est en gras
Option Explicit
Dim Fso As FileSystemObject
'DETAIL DE L'ADRESS
Type Export_csv
Colonne_A As String
Colonne_B As String
Colonne_C As String
Colonne_D As String
Colonne_E As String
Colonne_F As String
Colonne_G As String
Colonne_H As String
Colonne_I As String
Colonne_J As String
End Type
'DETAIL DU FICHIER
Public Detail_Export_csv As Export_csv
'EMPLACEMENT DU FICHIER A CREER
Public Emplacement_Fichier As String
Private Function Ecriture_Entete() As Boolean
Set Fso = New FileSystemObject
Emplacement_Fichier = "C:\Export.csv"
On Error Resume Next
If Fso.FileExists(Emplacement_Fichier) = True Then
Fso.DeleteFile Emplacement_Fichier, True
End If
On Error GoTo 0
Set Fso = Nothing
On Error Resume Next
Open Emplacement_Fichier For Output As #1
Select Case Err.Number
Case Is = 0
Ecriture_Entete = True
Case 71
MsgBox "Le support n'est pas accessible.", vbExclamation, "Message"
Ecriture_Entete = False
Case Else
MsgBox Err.Description, vbExclamation, "Message"
Ecriture_Entete = False
End Select
On Error GoTo 0
End Function
Private Function Ecriture_Detail(Colonne_A As String, Colonne_B As String, Colonne_C As String, Colonne_D As String, Colonne_E As String, Colonne_F As String, Colonne_G As String, Colonne_H As String, Colonne_I As String, Colonne_J As String) As Boolean
Ecriture_Detail = False
Detail_Export_csv.Colonne_A = Colonne_A
Detail_Export_csv.Colonne_B = Colonne_B
Detail_Export_csv.Colonne_C = Colonne_C
Detail_Export_csv.Colonne_D = Colonne_D
Detail_Export_csv.Colonne_E = Colonne_E
Detail_Export_csv.Colonne_F = Colonne_F
Detail_Export_csv.Colonne_G = Colonne_G
Detail_Export_csv.Colonne_H = Colonne_H
Detail_Export_csv.Colonne_I = Colonne_I
Detail_Export_csv.Colonne_J = Colonne_J
On Error Resume Next
Print #1, Detail_Export_csv.Colonne_A & ";" & Detail_Export_csv.Colonne_B & ";" & Detail_Export_csv.Colonne_C & ";" & Detail_Export_csv.Colonne_D & ";" & Detail_Export_csv.Colonne_E & ";" & Detail_Export_csv.Colonne_F & ";" & Detail_Export_csv.Colonne_H & ";" & Detail_Export_csv.Colonne_I & ";" & Detail_Export_csv.Colonne_J
If Err.Number = 0 Then
Ecriture_Detail = True
Else
Ecriture_Detail = False
End If
On Error GoTo 0
End Function
Private Sub Ecriture_Fin()
Close #1
End Sub
Public Sub Export()
Call Ecriture_Entete
Dim Colonne_A As String
Dim Colonne_B As String
Dim Colonne_C As String
Dim Colonne_D As String
Dim Colonne_E As String
Dim Colonne_F As String
Dim Colonne_G As String
Dim Colonne_H As String
Dim Colonne_I As String
Dim Colonne_J As String
Dim I As Integer
Dim J As Integer
I = 1
Do Until ActiveSheet.Cells(I, 1).Value = ""
For J = 1 To 10
Select Case J
Case 1
Colonne_A = ActiveSheet.Cells(I, J).Value
Case 2
Colonne_B = ActiveSheet.Cells(I, J).Value
Case 3
Colonne_C = String(10 - Len(ActiveSheet.Cells(I, J).Value), "0") & ActiveSheet.Cells(I, J).Value
Case 4
Colonne_D = ActiveSheet.Cells(I, J).Value
Case 5
Colonne_E = ActiveSheet.Cells(I, J).Value
Case 6
Colonne_F = ActiveSheet.Cells(I, J).Value
Case 7
Colonne_G = ActiveSheet.Cells(I, J).Value
Case 8
Colonne_H = ActiveSheet.Cells(I, J).Value
Case 9
Colonne_I = ActiveSheet.Cells(I, J).Value
Case 10
Colonne_J = ActiveSheet.Cells(I, J).Value
End Select
Next J
If Ecriture_Detail(Colonne_A, Colonne_B, Colonne_C, Colonne_D, Colonne_E, Colonne_F, Colonne_G, Colonne_H, Colonne_I, Colonne_J) = False Then
Exit Do
End If
I = I + 1
Loop
Call Ecriture_Fin
End Sub
il ne te reste plus qu'a lancer la macro Export et ton fichier sera sur C:\Export.csv avec ta colonne C sur 10 charactères
Commande mj wow
