Exportation données via une macro

Bonjour à tous,

Comme je l'explique dans le fichier excel ci-joint, j'aimerais créer une extraction de deux fichiers de deux onglets différents dans mon classeur via un bouton et une macro qui lui serait associé.

Seulement je n'ai aucune idée de comment faire ... Pourriez-vous m'aider ?

Merci beaucoup pour votre aide.

Bonjour Benoit, bonjour le forum,

Le code ci-dessous, à attribuer a un seul bouton, fait les deux actions demandées :

Sub Macro1()
Dim CO As Workbook 'déclare la variable CO (Classeur Origine)
Dim OO As Object 'déclare la variable OO (Onglet Origine)
Dim SD As FileDialog 'déclare la variable SD (Sélection de Dossier)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Object 'déclare la variable OD (Onglet Destination)

Set CO = ThisWorkbook 'définit le classeur origine CO
Set OO = CO.Sheets("Onglet 1") 'définit l'onglet origine OO
Set SD = Application.FileDialog(msoFileDialogFolderPicker) 'définit la séléction de dossier SD
If SD.Show = -1 Then CH = SD.SelectedItems(1) 'définit le chemin CH
Set SD = Nothing 'vide la variable SD
Workbooks.Add 'ajoute un classeur vierge
ActiveWorkbook.SaveAs (CH & "\" & "mensuel.prn") 'enregistre le classeur sous
Set CD = ActiveWorkbook 'définit le classeur CD
Set OD = CD.Sheets(1) 'définit l'onglet OD
OO.Range("A1").CurrentRegion.Copy 'copy les données de la colonne A de l'onglet OO
OD.Range("A1").PasteSpecial (xlPasteValues) 'les colle dans A1 de l'onglet OD
OO.Range("D1").CurrentRegion.Copy 'copy les données de la colonne D de l'onglet OO
OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues) 'les colle dans la première cellule vide de la colonne A de l'onglet OD
CD.Close True 'ferme le classeur en enregistrant les modifications
OO.Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0).Value = "Chemin fichier mensuel.prn :" 'écrit "Chemin fichier mensuel.prn :" en bas de colonne A
OO.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = CH 'écrit le chemin en dessous

Set OO = Sheets("Onglet 2") 'redéfinit l'onglet OO
Set SD = Application.FileDialog(msoFileDialogFolderPicker) 'définit la séléction de dossier SD
If SD.Show = -1 Then CH = SD.SelectedItems(1) 'définit le chemin CH
Set SD = Nothing 'vide la variable SD
Workbooks.Add 'ajoute un classeur vierge
ActiveWorkbook.SaveAs (CH & "\" & "mensuel_fc.prn") 'enregistre le classeur sous
Set CD = ActiveWorkbook 'définit le classeur CD
Set OD = CD.Sheets(1) 'définit l'onglet OD
OO.Range("A1").CurrentRegion.Copy 'copy les données de la colonne A de l'onglet OO
OD.Range("A1").PasteSpecial (xlPasteValues) 'les colle dans A1 de l'onglet OD
CD.Close True 'ferme le classeur en enregistrant les modifications
OO.Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0).Value = "Chemin fichier mensuel_fc.prn :" 'écrit "Chemin fichier mensuel_fc.prn :" en bas de colonne A
OO.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = CH 'écrit le chemin en dessous
End Sub

Bonjour Benoit, bonjour le forum,

Non et je t'avoue que je ne connait pas cette extension .pnr. Chez moi je n'arrive même pas à les ouvrir. Ne pourrais tu pas conserver le format Excel ?

Un fichier PRN est un fichier d'impression, c'est-à-dire un fichier contenant les données binaires. En gros c'est ni plus ni moins qu'un fichier .txt. Le problème c'est que le processus qui alimente ma base avec ce fichier ne prend en compte que les fichiers en .prn.

Je pense qu'il y a un problème lors de l'extraction d'encodage.

Par contre serait-il possible au lieu de choisir l'emplacement du fichier via une fenêtre de sélection, de mettre le chemin du fichier en dur sur ma feuille excel, et la macro prendrait en compte l'emplacement pour y déposer le fichier. Plutôt que choisir à chaque fois le dossier de destination ?

Dernière info : J'ai essayé en format CSV et txt mais le problème est le même ...

J'ai essayé en format CSV et txt mais le problème est le même ...

bonjour benoit, bonjour le forum,

Ben@it a écrit :

Par contre serait-il possible au lieu de choisir l'emplacement du fichier via une fenêtre de sélection, de mettre le chemin du fichier en dur sur ma feuille excel, et la macro prendrait en compte l'emplacement pour y déposer le fichier. Plutôt que choisir à chaque fois le dossier de destination ?

Oui c'est même plus facile ! Mais il faut que tu me dises où exactement se trouvent ces renseignements...

Par exemple dans les cellules A30 et A32 dans l'onglet procédure.

Bonjour Benoit, bonjour le forum,

Essaie comme ça :

Sub Macro1()
Dim CO As Workbook 'déclare la variable CO (Classeur Origine)
Dim OO As Object 'déclare la variable OO (Onglet Origine)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Object 'déclare la variable OD (Onglet Destination)

Set CO = ThisWorkbook 'définit le classeur origine CO
Set OO = CO.Sheets("Onglet 1") 'définit l'onglet origine OO
CH = Sheets("procédure").Range("A30")
Workbooks.Add 'ajoute un classeur vierge
ActiveWorkbook.SaveAs (CH & "\" & "mensuel.csv") 'enregistre le classeur sous
Set CD = ActiveWorkbook 'définit le classeur CD
Set OD = CD.Sheets(1) 'définit l'onglet OD
OO.Range("A1").CurrentRegion.Copy 'copy les données de la colonne A de l'onglet OO
OD.Range("A1").PasteSpecial (xlPasteValues) 'les colle dans A1 de l'onglet OD
OO.Range("D1").CurrentRegion.Copy 'copy les données de la colonne D de l'onglet OO
OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues) 'les colle dans la première cellule vide de la colonne A de l'onglet OD
CD.Close True 'ferme le classeur en enregistrant les modifications
'OO.Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0).Value = "Chemin fichier mensuel.prn :" 'écrit "Chemin fichier mensuel.prn :" en bas de colonne A
'OO.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = CH 'écrit le chemin en dessous

Set OO = Sheets("Onglet 2") 'redéfinit l'onglet OO
CH = Sheets("procédure").Range("A32")
Workbooks.Add 'ajoute un classeur vierge
ActiveWorkbook.SaveAs (CH & "\" & "mensuel_fc.csv") 'enregistre le classeur sous
Set CD = ActiveWorkbook 'définit le classeur CD
Set OD = CD.Sheets(1) 'définit l'onglet OD
OO.Range("A1").CurrentRegion.Copy 'copy les données de la colonne A de l'onglet OO
OD.Range("A1").PasteSpecial (xlPasteValues) 'les colle dans A1 de l'onglet OD
CD.Close True 'ferme le classeur en enregistrant les modifications
'OO.Cells(Application.Rows.Count, 1).End(xlUp).Offset(2, 0).Value = "Chemin fichier mensuel_fc.prn :" 'écrit "Chemin fichier mensuel_fc.prn :" en bas de colonne A
'OO.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = CH 'écrit le chemin en dessous
End Sub

Encore merci ThauThème pour ton aide. La commande des fichiers marche très bien, par contre j'ai toujours un problème sur le format. Il y a un soucis d'encodage, et quand j'ouvre les fichiers csv sur excel, j'ai le message (ci-joint) qui apparaît...

Dans tous les hiéroglyphes je vois des choses de ce genre là :

" xl/worksheets/sheet2.xmlŒ’ÁjÃ0"

Une idée ?? Parce que sinon franchement tout marche parfaitement bien. Mais je n'arrive pas à lire mes deux fichiers en sortie... De ton côté ça marche ? Tu peux ouvrir via un outil type notepad le fichier et lire son contenu ?

Bonjour Benoit, bonjour le forum,

Désolé pour le retard. J'ai moi aussi, en csv, un message disant que le fichier ne correspondait pas à l'extension et n'était pas une source fiable. Du coup, j'ai pas ouvert. Mais à l'ouverture de ton fichier d'origine j'ai aussi un message indiquant des liaisons. Ceci n'expliquerait-il pas cela ?... Désolé mais je n'ai pas d'autre solution que celle proposée.

Bonjour ThauThème,

J'ai réussi à construire ça ce weekend, mais j'ai un problème avec des guillemets en double... As-tu une idée pour résoudre ce problème ?

Sub Macro1()

Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim ceClasseur As Workbook
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim OD As Worksheet
'Definition des variables
Set ceClasseur = ThisWorkbook
Set Sh1 = ceClasseur.Sheets("Onglet 1")
Set Sh2 = ceClasseur.Sheets("Onglet 2")

'-----------------------------------------
'Traitement onglet 1
'-----------------------------------------
  CH = Sheets("procédure").Range("A30")
'ajoute un classeur vierge
  Workbooks.Add
'définit le classeur CD
  Set CD = ActiveWorkbook
'définit l'onglet OD
  Set OD = CD.Sheets(1)
'copy les données de la colonne A de l'onglet OO
  Sh1.Range("A1").CurrentRegion.Copy
'les colle dans A1 de l'onglet OD
  OD.Range("A1").PasteSpecial (xlPasteValues)
'copy les données de la colonne D de l'onglet OO
  Sh1.Range("D1").CurrentRegion.Copy
'les colle dans la première cellule vide de la colonne A de l'onglet OD
  OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)

'Sauvegarde du fichier CSV
 CD.SaveAs Filename:=CH & "\" & "mensuel.csv", _
           FileFormat:=xlCSV, _
           CreateBackup:=False, _
           Local:=False
'Fermeture du classeur
 CD.Close savechanges:=False

'-----------------------------------------
'Traitement onglet 2
'-----------------------------------------
 CH = Sheets("procédure").Range("A32")
'ajoute un classeur vierge
  Workbooks.Add
'définit le classeur CD
  Set CD = ActiveWorkbook
'définit l'onglet OD
  Set OD = CD.Sheets(1)
'copy les données de la colonne A de l'onglet OO
  Sh2.Range("A1").CurrentRegion.Copy
'les colle dans A1 de l'onglet OD
  OD.Range("A1").PasteSpecial (xlPasteValues)

'Sauvegarde du fichier CSV
 CD.SaveAs Filename:=CH & "\" & "mensuel_fc.csv", _
           FileFormat:=xlCSV, _
           CreateBackup:=False, _
           Local:=False
'Fermeture du classeur
 CD.Close savechanges:=False

End Sub

Bonjour Benoit, bonjour le forum,

Tu les où les guillemets en double ?

Lorsque je clique sur mon bouton et qu'il me génère les deux fichiers en .csv quand je veux l'ouvrir via un éditeur de texte type notepad il me mets des doubles guillemets ! Alors que si je l'ouvre avec Excel j'ai le bon affichage. J'imagine qu'il ne doit pas prendre en compte les doubles guillemets quand il me génère la vue via Excel !

Bonjour Benoît, bonjour le forum,

Je suis désolé Benoît mais je ne peux pas t'aider davantage car je ne pratique pas ce genre d'extraction en CSV...

Bonjour ThauThème,

Merci quand même de ta précieuse aide. Je vais encore chercher un peu et je te tiendrai au courant !