Extraire/Enregistrer Sous Feuilles d'un classeur en CSV

**rom22950** · 14/08/2014, 15h42

Bonjour à tous,

Je viens vers vous car je sens que je suis proche du but mais je rame pour trouver la solution définitive à mon problème.

Ici je souhaite extraire différentes feuilles d'un classeur excel (de 15 feuilles) et choisir ou les enregistrer en gardant comme base le nom de la feuille puis la date qui aura été préalablement rentrée par l'utilisateur.

Ici je pense qu'il me manque une étape ou je dois d'abord créer un nouveau classeur et non juste enregistrer mais je n'en suis pas capable...

Voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Test()
 
    Dim chemin As String
    Dim objShell As Object, objFolder As Object, oFolderItem As Object
    Dim i As Byte
 
    Nom = InputBox("Entrer la date du l'arrêté comptable :")
 
    i = SAS
    Sheets(i).Select
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
    On Error GoTo Gesterr
 
    Set oFolderItem = objFolder.Items.Item
    chemin = oFolderItem.Path
    ActiveWorkbook.SaveAs Filename:=i & Nom & ".csv", FileFormat:=xlCSV
 
Gesterr::
 
End Sub

Voilà, j'espère avoir été clair dans mon explication, merci d'avance pour votre soutien!

**kiki29** · 15/08/2014, 05h18

Salut, un exemple à élaguer dont tu pourras t'inspirer

**piotr76** · 15/08/2014, 11h25

Bonjour

Il manque la copie de la feuille à enregistrer dans un nouveau classeur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sheets("Ma_Feuille").Select
Sheets("Ma_feuille").Move
ActiveWorkbook.SaveAs Filename:="Nom_Complet_de_mon_fichier.csv", _
FileFormat:=xlCSV, CreateBackup:=False, Local:=True

(Le local, c'est pour avoir les points-virgule et non les virgules en séparateur)

Sinon il y a aussi Application.FileDialog pour choisir le répertoire
(Je travaille avec XL2007)
@+

**rom22950** · 18/08/2014, 09h51

Bonjour,

Merci cela marche déjà beaucoup mieux, cependant encore un petit point, lorsque j'active la macro l'enregistrement ce fait automatiquement dans le répertoire P:/Mes Documents et je ne comprends pas pourquoi...

Une idée?

Voici mon code retravaillé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Test()
 
    Dim chemin As String
    Dim objShell As Object, objFolder As Object, oFolderItem As Object
 
 
    Nom = InputBox("Entrer la date du mois en cours au format mmyyyy :")
 
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
    On Error GoTo Gesterr
 
    Set oFolderItem = objFolder.Items.Item
    chemin = oFolderItem.Path
    Sheets("LOC").Select
    Sheets("LOC").Copy
    ActiveWorkbook.SaveAs Filename:="LOC" & Nom & ".csv",_
    FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    ActiveWorkbook.Close
 
Gesterr::
 
End Sub

**SfJ5Rpw8** · 18/08/2014, 10h02

bonjour,

tu utilise une variable chemin dans laquelle tu stocke le répertoire de destination ... mais tu oublie ensuite d'utiliser cette variable dans le calcul du nom de fichier (fileName) ...

**rom22950** · 18/08/2014, 10h12

Il faut le faire dans ce genre la ?

Ca ne marche toujours pas même en faisant intervenir la variable chemin en question..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub Test()
 
    Dim chemin As String
    Dim objShell As Object, objFolder As Object, oFolderItem As Object
 
 
    Nom = InputBox("Entrer la date du mois en cours au format mmyyyy :")
 
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
    On Error GoTo Gesterr
 
    Set oFolderItem = objFolder.Items.Item
    chemin = oFolderItem.Path
    Sheets("LOC").Select
    Sheets("LOC").Copy
    ActiveWorkbook.SaveAs Filename:= _
    chemin & "LOC" & Nom & ".csv", _
    FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    ActiveWorkbook.Close
 
Gesterr::
 
End Sub

**SfJ5Rpw8** · 18/08/2014, 10h20

Envoyé par rom22950

Ca ne marche toujours pas même en faisant intervenir la variable chemin en question..
..

et il se passe quoi à ce moment la ...?

**Marc-L** · 18/08/2014, 10h30

Bonjour, bonjour !

rom22950, et si tu regardais au moins dans la fenêtre des Variables locales avec un point d'arrêt dans le code (B-A-BA !)
le contenu de la variable chemin, tu verrais qu'il n'y a pas d'anti-slash à la fin !

Donc en ajouter un dans la chaine avant "LOC". Qui plus est tu pourrais te passer de cette variable …

__________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

**rom22950** · 18/08/2014, 10h42

Bonjour et merci,

En effet maintenant le nouveau classeur est bien enregistré au bon endroit.

Cependant celui ci s'enregistre en .csv séparateur virgule et non point virgule..

Avez vous une idée d'ou peut provenir le problème?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub Test()
 
    Dim chemin As String
    Dim objShell As Object, objFolder As Object, oFolderItem As Object
 
 
    Nom = InputBox("Entrer la date du mois en cours au format mmyyyy :")
 
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
    On Error GoTo Gesterr
 
    Set oFolderItem = objFolder.Items.Item
    chemin = oFolderItem.Path
    Sheets("LOC").Select
    Sheets("LOC").Copy
    ActiveWorkbook.SaveAs Filename:= _
    chemin & "\" & "LOC" & Nom & ".csv", _
    FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    ActiveWorkbook.Close
 
Gesterr::
 
End Sub

**Marc-L** · 18/08/2014, 10h52

Tester en retirant Local:=True, utile en lecture mais inutile en enregistrement avec une version française d'Excel …

__________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

**rom22950** · 18/08/2014, 10h55

Non malheureusement ça ne change rien le fichier est toujours en .csv séparateur virgule avec ou sans le local:=True

**Marc-L** · 18/08/2014, 10h58

Version française d'Excel ou pas ? Et manuellement avec Enregistrer sous … ?

Sinon vérifier le paramétrage régional de Windows …

__________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

**rom22950** · 18/08/2014, 11h01

Oui c'est bien la version française d'excel, et tous les paramêtres sont sur Français également..

En enregistrement manuel le fichier est bien en séparateur point virgule

**Marc-L** · 18/08/2014, 11h04

Bon alors le refaire manuellement en utilisant l'Enregistreur de macros, le code est livré sur un plateau ‼

__________________________________________________________________________________________

Merci de cliquer sur

pour chaque message ayant aidé puis sur

pour clore cette discussion …

**rom22950** · 18/08/2014, 11h11

Parfaitement incopréhensible, quand j'utilise l'enregistreur de macro il enlève le local:=True et le fichier est en effet enregistrer en csv séparateur point virgule

Cependant quand je copie la macro enregistrée avec l'enregistreur le fichier s'enregistre en csv séparateur virgule...

**rom22950** · 18/08/2014, 11h19

C'est bon j'ai trouvé, il fallait remplacer le "ActiveWorkbook.Close" par "ActiveWorkbook.Close SaveChanges:=False"

Extraire/Enregistrer Sous Feuilles d'un classeur en CSV [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager