Microsoft 365 VBA: importer dans un dossier avec un nom variable

[A-F]

Bonjour,
J'ai besoin votre aide et j'en remercie par avance,
Je sais qu'on peut enregistrer un dans un même endroit où il y a notre fichier. Mais ca m'aide pas vraiment.

Pour vous mettre dans le contexte:
je travaille sur les diffèrent fichiers dans diffèrent dossiers ( le Mis en pages de tous les fichiers sont la même). Je copie certaines colonnes de ces fichiers en demandant à l'utilisateur d'ouvrir le fichier. Je souhait ensuite enregistrer ce fichier dans un dossier ( export) qui est dans le même dossier ou l'utilisateur a choisi le fichier. Ce qui je n'arrive pas à faire.

Je peux enregistrer tous l'export dans un dossier quelconque mais comment je peux récupérer l'adresse de fichier ouvert pour ensuite mettre mon fichier dans un dossier export dans même dossier ?

Je pense que je ne suis pas claire mais j'espère que vous m'avez quand même copris :-(

Le code pour carrer mes fichier à exporter les données dedans :

'Creer les fichier d'export pour les 6 actes
Function ClasseursExport()
  
 
    Dim ws_data As Worksheet
    Dim lstrw As Long
    Dim nom_prenom As String
    Dim chemin_dossier As String
    Dim chemin_sous_dossier As String
    Dim Classeur As Workbook
    
    'identifier la feuille
    Set ws_data = Worksheets(1)
    
    'derniere ligne
    lstrw = ws_data.Cells(Rows.Count, 1).End(xlUp).Row
        
    
        chemin_dossier = "Z:\Adresse\TDB\Export\" & Format(Date, "mm-yyyy") & "\" 
    
        
        'vérifier existence du dossier
        If Dir(chemin_dossier, vbDirectory) <> vbNullString Then
            'dossier existe
        Else
            'créer le dossier
            MkDir (chemin_dossier)
        
            ' Save le fichier exporte
            Workbooks.Add.SaveAs Filename:=chemin_dossier & "fichier_import_A1"
            Workbooks.Add.SaveAs Filename:=chemin_dossier & "fichier_import_A2"
            Workbooks.Add.SaveAs Filename:=chemin_dossier & "fichier_import_A3"
            Workbooks.Add.SaveAs Filename:=chemin_dossier & "fichier_import_A4"
            Workbooks.Add.SaveAs Filename:=chemin_dossier & "fichier_import_A4b"
            Workbooks.Add.SaveAs Filename:=chemin_dossier & "fichier_import_A5"
          
        End If
        
    Workbooks("fichier_import_A1").Worksheets(1).Name = "fichier_import_A1"
    Workbooks("fichier_import_A2").Worksheets(1).Name = "fichier_import_A2"
    Workbooks("fichier_import_A3").Worksheets(1).Name = "fichier_import_A3"
    Workbooks("fichier_import_A4").Worksheets(1).Name = "fichier_import_A4"
    Workbooks("fichier_import_A4b").Worksheets(1).Name = "fichier_import_A4b"
    Workbooks("fichier_import_A5").Worksheets(1).Name = "fichier_import_A5"
    
   'Ajouter les colonnes dans le "fichier_import_A1"
    Workbooks("fichier_import_A1").Worksheets("fichier_import_A1").Cells(1, 1) = "userEmail"
    Workbooks("fichier_import_A1").Worksheets("fichier_import_A1").Cells(1, 2) = "actCreationDate"
    Workbooks("fichier_import_A1").Worksheets("fichier_import_A1").Cells(1, 3) = "actType"

Ensuite j'utiliser ces fichier pour faire mes traitement :

Sub Export_TDB_auChoix()
    Dim C As Range
    Dim nb As Integer, i As Integer, nbA01 As Integer, TotalA01 As Integer, j As Integer, NextRow As Integer, FinalRow As Integer, FinalColumn As Integer, NextColumns As Integer
    Dim ThisValue As String
    Dim Classeur As Workbook
    Dim LaFeuille As Worksheet
    Dim Msg As String, FichierEx As String
    Dim NomFichier As Variant
    
    'On désactive le presse-papier et le raffraichissement de l'écran
    Application.CutCopyMode = False
    Application.ScreenUpdating = False


   'Appler le programme pour creer le fichier export
    FichierEx = ClasseursExport()
    

    
    'Activer le fichier choisit
    NomFichier = Application.GetOpenFilename("Fichiers Texte (*.txt),*.txt,Tous les fichiers (*.*),*.* ", 1, "Sélectionnez le fichier des écritures à importer", , False)
        
        If NomFichier = False Then Exit Sub
        If NomFichier <> False Then
            Set Classeur = Application.Workbooks.Open(NomFichier)
        End If

      
  
    'Compter le nb de ligne/dossier dans le fichier
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    
    'Copier les donner de chaque ligne/dossier  dans le fichier "fichier_import_A1":
    
            For i = 6 To 14
            
                 For Each C In Classeur.Worksheets("TDB - Type").Range("AS" & i & ":DV" & i) 'la palage de Acte A01
                    
                
                     If C.Value = "A01" Then ' si la valeure de cellule = A01
                      
                        'Activer le fichier export
                        Workbooks("fichier_import_A1.xlsx").Activate
                                
                    
                                Classeur.Worksheets("TDB - Type").Range("E" & i).Copy 'UserEmail
                
                                'Trouver la dernier ligne
                                Workbooks("fichier_import_A1.xlsx").Activate
                                NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
                                
                                
                                'Paste
                                Cells(NextRow, 1).Select
                                ActiveCell.PasteSpecial Paste:=xlPasteValues

il faut que j'arrive à copier mes données dans le dossier export qui est dans même dossier où on a choisit le classeurs, dans le dossier que j'ai crré avant avec le date de mois et l'année.

ca me parait un peu trop complique, vous me dite si ce n'est pas du tout possible!

 

[vgendron]

Bonjour

au moment où tu ouvres le fichier choisi par l'utilisateur, il te suffit de récuperer le chemin
Set Classeur = Application.Workbooks.Open(NomFichier) 'ouvre le fichier qui devient le fichier actif
RepSauv=activeworkbook.path

tu utilises ensuite le RepSauv pour ta sauvegarde

 

[A-F]

Bonjour Vgendron,
Merci d'avoir pris le temps pour rependre.
je ne sais pas si récupérer le chemin avec path va marcher car je veux faire mon export dans un dossier "Exporte" dans même chemin qu'activeworkbook.
Théoriquement si j'utilise RepSauv=activeworkbook.path, il enregistre mon fichier à coter de activeworkbook et pas dans un dossier, non ?

 

[vgendron]

Bonjour

si tu ne sais pas si ca va marcher.. faut au moins essayer..

Sub test()

NomFichier = Application.GetOpenFilename 'demande le fichier à ouvrir
If Not NomFichier = "" Then
    Workbooks.Open NomFichier 'ouvre le fichier: qui devient le classeur actif
    RepertoireActif = ActiveWorkbook.Path 'on récupère le dossier
    MsgBox ("le répertoire du fichier qui vient d'etre ouvert est: " & RepertoireActif)
    RepertoireSauvegarde = RepertoireActif & "\Exporte"
    
    If Dir(RepertoireSauvegarde) = "" Then
        MsgBox "le répertoire de sauvegarde n'existe pas: on le créé"
        MkDir (RepertoireSauvegarde)
    End If
End If
End Sub

 

[A-F]

Bonjour

si tu ne sais pas si ca va marcher.. faut au moins essayer..

Sub test()

NomFichier = Application.GetOpenFilename 'demande le fichier à ouvrir
If Not NomFichier = "" Then
    Workbooks.Open NomFichier 'ouvre le fichier: qui devient le classeur actif
    RepertoireActif = ActiveWorkbook.Path 'on récupère le dossier
    MsgBox ("le répertoire du fichier qui vient d'etre ouvert est: " & RepertoireActif)
    RepertoireSauvegarde = RepertoireActif & "\Exporte"
  
    If Dir(RepertoireSauvegarde) = "" Then
        MsgBox "le répertoire de sauvegarde n'existe pas: on le créé"
        MkDir (RepertoireSauvegarde)
    End If
End If
End Sub

Merci je vais essayer ca!