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.
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+
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]
A+
Re, BrunoM45
Vu ta réponse, je n'ai qu'à clôturer cette discussion.
Merci beaucoup pour ton aide.
Bonne journée.