Microsoft 365 Macro pour création fichier csv

[BALMGOLF]

Bonjour
Sur une feuille excel j' ai partir de la ligne 12 :
Colonne A des dates classées Entre 2 et 5 dates
Colonne B des horaires
Colonne C des codes créés par une formule

Je veux avoir autant de fichiers csv que de dates avec uniquement les elements de la colonne C dans une colonne A
J'ai créé une macro qui ne fonctionne pas et je ne vois pas pourquoi.
Sub csv()

Jour = Cells(12, 1).Value
Open "C:/TEMP/" & Format(Jour, "ddmmyyyy") & ".csv" For Output As #1

For i = 12 To n
If Cells(i, 1) <> Jour Then
Close #1
Jour = Cells(i, 1)
Open "C:/TEMP/" & Format(Jour, "ddmmyyyy") & ".csv" For Output As #1
End If
Print #1, Cells(i, 3)
Next i
Close #1

End Sub

Merci de trouver pourquoi

 

[wDog66]

Bonsoir,
Vous êtes sur Mac, il faudrait le spécifier 🤔
Sinon si vous êtes sur PC, vous vous êtes trompé de barre de séparation, il faut utiliser "C:\xxxx\yyyy"
A+

 

[job75]

Bonjour BALMGOLF, wDog66, le forum,

Téléchargez le fichier joint dans un Nouveau dossier du bureau et exécutez cette macro :

Sub csv()
Dim ps$, i&, x%
ps = Application.PathSeparator
i = 12
While Cells(i, 1) <> ""
    If Cells(i, 1) <> Cells(i - 1, 1) Then
        If x Then Close #x
        x = FreeFile
        Open ThisWorkbook.Path & ps & Format(Cells(i, 1), "yyyymmdd") & ".csv" For Output As #x
    End If
    Print #x, Cells(i, 3)
    i = i + 1
Wend
If x Then Close #x
End Sub

Elle fonctionne sur PC ou sur MAC.

Il vaut mieux le format "yyyymmdd" pour le classement des fichiers.

A+

 

[job75]

On peut préférer cette macro :

Sub csv()
Dim ps$, tablo, i&, x%
ps = Application.PathSeparator
Range("A11:C" & Rows.Count).Sort Columns(1), xlAscending, Header:=xlYes 'tri sur colonne A
tablo = [A11].CurrentRegion.Resize(, 3) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    If tablo(i, 1) <> tablo(i - 1, 1) Then
        If x Then Close #x
        x = FreeFile
        Open ThisWorkbook.Path & ps & Format(tablo(i, 1), "yyyymmdd") & ".csv" For Output As #x
    End If
    Print #x, tablo(i, 3)
Next
If x Then Close #x
End Sub

 

[BALMGOLF]

Bonsoir,
Vous êtes sur Mac, il faudrait le spécifier 🤔
Sinon si vous êtes sur PC, vous vous êtes trompé de barre de séparation, il faut utiliser "C:\xxxx\yyyy"
A+

merci mais je suis bien sur PC

 

[Cousinhub]

Bonjour,
Pas vraiment sympa ce :

J'ai créé une macro qui ne fonctionne pas et je ne vois pas pourquoi.

Vraiment?
Un peu d'humilité, stp....

 

[BALMGOLF]

On peut préférer cette macro :

Sub csv()
Dim ps$, tablo, i&, x%
ps = Application.PathSeparator
Range("A11:C" & Rows.Count).Sort Columns(1), xlAscending, Header:=xlYes 'tri sur colonne A
tablo = [A11].CurrentRegion.Resize(, 3) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    If tablo(i, 1) <> tablo(i - 1, 1) Then
        If x Then Close #x
        x = FreeFile
        Open ThisWorkbook.Path & ps & Format(tablo(i, 1), "yyyymmdd") & ".csv" For Output As #x
    End If
    Print #x, tablo(i, 3)
Next
If x Then Close #x
End Sub

Merci Job75
C'est vraiment ce que je voulais je vais essayer de comprendre la macro car il y a des fonctions que je ne connais pas.
Un seul petit pb cela me creer un fichier .csv en plus (dont le nom est vide) Je pense que c'est à cause de la ligne suivante de ma derniere ligne (donc ligne 233) qui a une formule de calcul dont le résultat est est un " " .
Ce n'est pas grave je supprimerai ce fichier à chaque opération
Vous avez aider une petite association de Golf (Joueurs retraités). notre site pour info:

Accueil | Circuitsenioroccitan

Le Circuit Senior Occitan est destiné aux golfeurs de plus de 50 ans. Il se déroule sur 20 à 30 étapes sur l'Est de l'Occitanie et en Lot et Garonne.

golfsenioroccitan.wixsite.com

Merci encore
Jean Jacques

 

[job75]

Un seul petit pb cela me creer un fichier .csv en plus (dont le nom est vide) Je pense que c'est à cause de la ligne suivante de ma derniere ligne (donc ligne 233) qui a une formule de calcul dont le résultat est est un " " .
Ce n'est pas grave je supprimerai ce fichier à chaque opération

Sur votre fichier post #1 il y a des textes vides "" de la ligne 233 à la ligne 500.

Pour ne pas en tenir compte il suffit d'ajouter un test :

Sub csv()
Dim ps$, tablo, i&, x%
ps = Application.PathSeparator
Range("A11:C" & Rows.Count).Sort Columns(1), xlAscending, Header:=xlYes 'tri sur colonne A
tablo = [A11].CurrentRegion.Resize(, 3) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    If Trim(tablo(i, 1)) <> "" Then
        If tablo(i, 1) <> tablo(i - 1, 1) Then
            If x Then Close #x
            x = FreeFile
            Open ThisWorkbook.Path & ps & Format(tablo(i, 1), "yyyymmdd") & ".csv" For Output As #x
        End If
        Print #x, tablo(i, 3)
    End If
Next
If x Then Close #x
End Sub

 

[job75]

Bonjour,

Ah et puis il est vraiment stupide d'avoir des textes vides sous les dates, supprimons-les :

Sub csv()
Dim ps$, derlig As Variant, tablo, i&, x%
ps = Application.PathSeparator
Range("A11:C" & Rows.Count).Sort Columns(1), xlAscending, Header:=xlYes 'tri sur colonne A
derlig = Application.Match([9^9], Columns(1))
If IsError(derlig) Then derlig = 11 
Range("A" & derlig + 1 & ":C" & Rows.Count).Delete xlUp 'suppression des textes
tablo = [A11].CurrentRegion.Resize(, 3) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    If tablo(i, 1) <> tablo(i - 1, 1) Then
        If x Then Close #x
        x = FreeFile
        Open ThisWorkbook.Path & ps & Format(tablo(i, 1), "yyyymmdd") & ".csv" For Output As #x
    End If
    Print #x, tablo(i, 3)
Next
If x Then Close #x
End Sub

A+