Créer Réperoire et csv

Bonjour ,

Je voudrais créer un dossier et y enregistrer 3 feuilles en cvs.

Vous comprendrez mieux la problématique dans le fichier zip ci-joint.

Le zip contient 2 fichier et des répertoires (voir fichier Source dans dossier 2108).

En vous remerciant par avance.

Bonne journée.

6travail.zip (141.51 Ko)

Bonjour CP4,

Voici ton fichier source avec le code qui va bien, normalement

Dans un module

Option Explicit

Sub BackupFermeture()
  Dim sPath As String
  ' Chemin actuel
  sPath = ThisWorkbook.Path
  ' Dossier parent = chemin avant le dernier slash
  sPath = Left(sPath, InStrRev(sPath, "\") - 1)
  ' Vérifier que le répertoir MàJ existe
  If Not DossierExiste(sPath, "MàJ") Then Exit Sub
  ' Ajouter le dossier MàJ au chemin
  sPath = sPath & "\MàJ"
  ' Empècher le rafraichissement d'écran
  Application.ScreenUpdating = False
  ' Créer les fichiers CSV
  ThisWorkbook.Sheets("A").Copy
  With ActiveWorkbook
    .SaveAs Filename:=sPath & "\A.csv", FileFormat:=xlCSV, CreateBackup:=False
    .Close SaveChanges:=False
  End With
  ThisWorkbook.Sheets("B").Copy
  With ActiveWorkbook
    .SaveAs Filename:=sPath & "\B.csv", FileFormat:=xlCSV, CreateBackup:=False
    .Close SaveChanges:=False
  End With
  ThisWorkbook.Sheets("C").Copy
  With ActiveWorkbook
    .SaveAs Filename:=sPath & "\C.csv", FileFormat:=xlCSV, CreateBackup:=False
    .Close SaveChanges:=False
  End With
  ' Réactiver le rafraichissement
  Application.ScreenUpdating = True
  ' Petit message
  MsgBox "Feuilles copiée et enregistrée en CSV dans le dossier :" & vbCr _
  & sPath, vbInformation, "C'EST BON ..."
End Sub

' Fonction qui teste l'existence d'un dossier et de spon arborescence
' Avec création de celle-ci si n'existe pas
Function DossierExiste(Chemin As String, Dossier As String) As Boolean
  Dim sPathD As String
  ' En cas d'erreur on continue
  On Error Resume Next
  ' Chemin d'accès
  sPathD = Chemin & "\" & Dossier
  ' Vérifier si le chemin existe, sinon le créer
  If Dir(sPathD, vbDirectory) = "" Then MkDir sPathD
  ' En cas d'erreur, on annule la création du chemin d'accès
  If Err.Number <> 0 Then DossierExiste = False Else DossierExiste = True
  ' réactiver la gestion d'erreur
  Err.Clear
  On Error GoTo 0
End Function

Dans ThisWorkbook

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Call BackupFermeture
End Sub

A+

7source.xlsm (110.62 Ko)

Bonjour BrunoM45 ,

C'est impeccable, Merci beaucoup.

Cependant, j'ai une petite question par rapport aux fichiers csv créés.

Serait-il possible que les données soient à l'identique des feuilles d'origines

c-à-d les données dans des colonnes différentes.

Pour le fichier de destination, c-à-d la procédure inverse copier les donnes des csv vers le fichier,

je vais essayer de le faire. Si je peine à résoudre le problème, j'ouvrirai une autre discussion.

Tous mes remerciements, ma gratitude.

Bonne journée.

Re

[quote=CP4 post_id=647380 time=1525423930 user_id=27266]

Cependant, j'ai une petite question par rapport aux fichiers csv créés.

Serait-il possible que les données soient à l'identique des feuilles d'origines

c-à-d les données dans des colonnes différentes.[/QUOTE]

du CSV reste du CSV, c'est à dire données séparées par des point virgules

A+

Re, BrunoM45 ,

Vu ta réponse, je n'ai qu'à clôturer cette discussion.

Merci beaucoup pour ton aide.

Bonne journée.

Rechercher des sujets similaires à "creer reperoire csv"