Discussion :

[Isicare]

Bonjour !
Je suis un peu embêté car je souhaite sauvegarder un fichier sous un nom que je connais mais je voudrais pouvoir choisir le dossier d'enregistrement et ceci pour chaque enregistrement. Je vous joint le VBA déjà effectué.*
En attente de vos réponses !

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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub Macro1()
'
' Macro1 Macro
'Ouvrir une boîte de dialogue pour ouvrir un fichier
Dim Nom As String
    Classeur = Application.GetOpenFilename()
    If Classeur = False Then Exit Sub
    Workbooks.Open Filename:=Classeur
'Enregistre le nom du fichier ouvert
Nom = ActiveWorkbook.Name
'Convertir les virgules en nouvelles colonnes
  Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
        TrailingMinusNumbers:=True
'Convertir les points en virgules
    Columns("C:AS").Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
'Enregistrer sur un fichier de nom connu
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & "Test.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    Application.DisplayAlerts = True
'Copier/Coller
    Windows("Test.xlsm").Activate
    Columns("C:AS").Select
    Selection.Copy
    Windows("Coucou.xlsm").Activate
    Sheets(1).Select
    Range("A1").Select
    ActiveSheet.Paste
'Nomme l'onglet correspondant au fichier
    Sheets(1).Name = Nom
'Ferme le fichier Test pour pouvoir l'écraser lors du traitement du prochain fichier
    Application.DisplayAlerts = False
    Workbooks("Test.xlsm").Close False
    Application.DisplayAlerts = False
'Ouvre une boîte contextuelle pour enregistrer sous
    Application.Dialogs(xlDialogSaveAs).Show
End Sub

[mercatog]

Ouvre un fichier, le transforme, copie les données dans le fichier contenant la macro (après transformation des donnée) Ferme le fichier ouvert sans sauvegarder et enregistrer sous le fichier contenant la macro

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
26
27
28
29
30
Sub Macro1()
Dim Wbk As Workbook
Dim Nom As String
Dim Classeur
 
'Ouvrir une boîte de dialogue pour ouvrir un fichier
Classeur = Application.GetOpenFilename()
If Classeur = False Then Exit Sub
Set Wbk = Workbooks.Open(Classeur)
 
'Convertir les virgules en nouvelles colonnes
With Wbk.Worksheets(1)
    .Range("A:A").TextToColumns Destination:=.Range("A1"), _
                                DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
                                ConsecutiveDelimiter:=False, Tab:=True, FieldInfo:=Array(Array(1, 1), _
                                                                                         Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
                                                                                         TrailingMinusNumbers:=True
    'Convertir les points en virgules
    With .Range("C:AS")
        .Replace What:=".", Replacement:=",", LookAt:=xlPart
        .Copy ThisWorkbook.Worksheets(1).Range("A1")
    End With
    .Name = Wbk.Name
End With
Wbk.Close False
Set Wbk = Nothing
 
'Enregistrer sur un fichier de nom connu
Application.Dialogs(xlDialogSaveAs).Show
End Sub