Option Explicit
Sub SAVECSV()
'***************variables************************* *
Dim derlig&, dercol%, colref%, colref2%, colref3%, colref4%, t1, t2, i&, cod1$, cod2$, j&
Dim colcode As Range
Dim NomFeuil1$, NomClasseur1$, NomFeuil2$, NomClasseur2$, Chemin$, Fich$
Dim LignACopier%, T&
'***************timer***************************** *
T = Timer 'pour chronométrer
'************************************************* *
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'************************************************* *
NomFeuil1 = ActiveSheet.Name 'nom de la feuille active
NomClasseur1 = ActiveWorkbook.Name 'nom du classeur actif
Chemin = ActiveWorkbook.Path
'************************************************* *
With Sheets(NomFeuil1)
colref = Application.Match("Code CREDO bénéficiaire", .[1:1], 0) 'référence de la colonne contenant les codes
colref2 = Application.Match("Code CREDO livraison", .[1:1], 0) 'référence de la colonne contenant les codes 2
colref3 = Application.Match("Prix estimé de la FEB", .[1:1], 0) 'référence de la colonne contenant les prix
colref4 = Application.Match("date modification", .[1:1], 0) 'référence de la colonne contenant les dates
derlig = .Cells(.Rows.Count, colref).End(xlUp).Row 'dernière ligne
dercol = .Cells(1, .Columns.Count).End(xlToLeft).Column 'dernière colonne
t1 = .[A1].Resize(1, dercol) 'ligne d'en-tête mémorisée dans tableau t1
Set colcode = .Range(Cells(1, colref), Cells(derlig, colref))
End With
'*********TRI SUR COLONNE [colref]*****************
Columns(colref).NumberFormat = "@"
With Worksheets(NomFeuil1).Sort
.SortFields.Clear
.SortFields.Add Key:=Range(Chr(64 + colref) & "1:" & Chr(64 + colref) & derlig) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range(Cells(1, 1), Cells(derlig, dercol))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'************************************************* *
t2 = Sheets(NomFeuil1).Range(Chr(64 + colref) & 2).Resize(derlig - 1, 1) 'colonne des codes mémorisée dans tableau t2
************Définition BOUCLE*********************
cod2 = ""
j = 0 ' la boucle doit s'arrêter lorsque 50 fichiers auront été créés. On commence par mettre le compteur à zéro
For i = 1 To derlig - 1
cod1 = t2(i, 1)
LignACopier = colcode.Find(cod1).Row 'numéro de la ligne à copier en dessous des en-têtes
If cod1 <> cod2 Then
If j >= 50 Then Exit For 'on arrête la boucle dès que 50 fichiers ont été créés
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=Chemin & "\" & cod1, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
NomClasseur2 = ActiveWorkbook.Name
NomFeuil2 = ActiveSheet.Name
cod2 = cod1
j = j + 1
With Workbooks(NomClasseur2).Sheets(NomFeuil2)
.[A1].Resize(1, dercol) = t1
Workbooks(NomClasseur1).Sheets(NomFeuil1).Rows(LignACopier).EntireRow.Copy Destination:=.[A2].Resize(1, dercol)
'********FORMATAGE DES COLONNES du FICHIER n°2*****
.Columns(colref).NumberFormat = "@" 'format texte pour une bonne recopie du code
.Columns(colref2).NumberFormat = "@" 'format texte pour une bonne recopie du code 2
.Columns(colref3).NumberFormat = "#,##0.00 $" 'format des prix
.Columns(colref4).NumberFormat = "m/d/yyyy h:mm" 'format de la date
End With
'********SAUVE en CONSERVANT le format CSV*********
Workbooks(NomClasseur2).SaveAs Filename:=Chemin & "\" & cod1, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
Workbooks(NomClasseur2).Close SaveChanges:=False
End If
Next i
'***********RETOUR AU CLASSEUR DE DEPART***********
Workbooks(NomClasseur1).Activate
'***************FIN DE LA BOUCLE*******************
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'**************AFFICHAGE du TIMER******************
MsgBox "Durée " & Format(Timer - T, "0.0 \s")
End Sub