XL 2019 Ouvrir le fichier le plus récent d'un dossier dans VBA

Cesar1275

XLDnaute Occasionnel
Bonjour à tous

Je souhaiterais créer un programme qui ouvre automatiquement le dernier fichier du répertoire C:\Users\0017475V\Documents\Solferino\Roulement .
Les fichiers sont nommés comme cela : JournalActionsRoulement_2021-02-24_10-08-43.xlsx (le 10-08-43 correspond à l'heure du fichier).

Une fois le fichier ouvert j'aimerais également pouvoir sélectionner le tableau présent dans le fichier (à partir de A9) et le copier coller dans un autre fichier ( à partir de A2).

En PJ vous trouverez les fichier (celui à ouvrir et celui ou il faut coller ( à partir de A2) le tableau sélectionné dans le premier).

N'hésitez pas à me poser des questions si ma demande n'est pas assez claire ;)
 

Pièces jointes

  • JournalActionsRoulement_2021-02-24_10-08-43.xlsx
    11 KB · Affichages: 21
  • Eléments supprimés.xlsm
    51.9 KB · Affichages: 8
Solution
Oui désolé comme je n'ai pas testé... Il manque un CurrentRegion.
Remplace :

VB:
OS.Range("A8").Offset(1, 0).Copy OD.Range("A2") 'copy le tableau de l'onglet source à partir de A9 et le colle dans A2 de l'onglet destination
par :
Code:
OS.Range("A8").CurrentRegion.Offset(1, 0).Copy OD.Range("A2") 'copy le tableau de l'onglet source à partir de A9 et le colle dans A2 de l'onglet destination

Robert

XLDnaute Barbatruc
Bonjour César, bonjour le forum,

Peut-être comme ça :

VB:
Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim EF As Object 'déclare la variable EF (Explorateur de Fichiers)
Dim DS As Object 'déclare la variable DS (Dossier Source)
Dim FS As Object 'déclare la variable FS (FichierS)
Dim F As Object 'déclare la variable F (Fichier)
Dim FN As String 'déclare la variable FN (Fin du Nom)
Dim DSer As Date 'déclare la variable DSer (Date Serial)
Dim HSer As Variant 'déclare la variable HSer (Heure Serial)
Dim DeH As Variant 'déclare la variable DeH (Date et Heure)
Dim Max As Variant 'déclare la variable Max (valeur MAXimale)
Dim NF As String 'déclare la variable NF (Nom du Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)

Set CD = ThisWorkbook 'définit la classeur destination CD
OD = CD.Worksheets(1) 'définit l'onglet destination OD
CA = "C:\Users\0017475V\Documents\Solferino\Roulement" 'définit le chemin d'acces CA
Set EF = CreateObject("Scripting.FileSystemObject") 'définit l'explorateur de fichiers EF
Set DS = EF.GetFolder(CA) 'définit le dossier source DS
Set FS = DS.Files 'définit l'ensemble des fichier FS du dossier source DS
For Each F In FS 'boucle sur tous les fichiers F de FS
    If Left(F.Name, 23) = "JournalActionsRoulement" Then 'condition : si le nom du fichier commence par "JournalActionsRoulement"
        FN = Split(Mid(F.Name, 25), ".")(0) 'définit la fin du nom FN (date et heure)
        DSer = DateSerial(Year(Split(FN, "_")(0)), Month(Split(FN, "_")(0)), Day(Split(FN, "_")(0))) 'définit le numero de série de la date DSer
        HSer = TimeSerial(Split(Split(FN, "_")(1), "-")(0), Split(Split(FN, "_")(1), "-")(1), Split(Split(FN, "_")(1), "-")(2)) 'définit le numéro de série de l'heure HSer
        DeH = DSer & " " & HSer 'définit la date et l'heure DeH
        If DeH > Max Then Max = DeH: NF = F.Name 'si Deh est supérieure à Max (qui au départ vaut 0), définit la variable Max et le nom du fichier NF
    End If 'fin de la condition
Next F 'prochain fichier de la boucle
Set CS = Workbooks.Open(CA & "\" & NF) 'définit la classeur source CS (ayant NF comme nom) en l'ouvrant
Set OS = CS.Worksheets(1) 'définit l'onglet source OS
OS.Range("A8").Offset(1, 0).Copy OD.Range("A2") 'copy le tableau de l'onglet source à partir de A9 et le colle dans A2 de l'onglet destination
CS.Close False 'ferme le classeur source sans enregistrer les modifications
End Sub
 

Cesar1275

XLDnaute Occasionnel
Bonjour César, bonjour le forum,

Peut-être comme ça :

VB:
Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim EF As Object 'déclare la variable EF (Explorateur de Fichiers)
Dim DS As Object 'déclare la variable DS (Dossier Source)
Dim FS As Object 'déclare la variable FS (FichierS)
Dim F As Object 'déclare la variable F (Fichier)
Dim FN As String 'déclare la variable FN (Fin du Nom)
Dim DSer As Date 'déclare la variable DSer (Date Serial)
Dim HSer As Variant 'déclare la variable HSer (Heure Serial)
Dim DeH As Variant 'déclare la variable DeH (Date et Heure)
Dim Max As Variant 'déclare la variable Max (valeur MAXimale)
Dim NF As String 'déclare la variable NF (Nom du Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)

Set CD = ThisWorkbook 'définit la classeur destination CD
OD = CD.Worksheets(1) 'définit l'onglet destination OD
CA = "C:\Users\0017475V\Documents\Solferino\Roulement" 'définit le chemin d'acces CA
Set EF = CreateObject("Scripting.FileSystemObject") 'définit l'explorateur de fichiers EF
Set DS = EF.GetFolder(CA) 'définit le dossier source DS
Set FS = DS.Files 'définit l'ensemble des fichier FS du dossier source DS
For Each F In FS 'boucle sur tous les fichiers F de FS
    If Left(F.Name, 23) = "JournalActionsRoulement" Then 'condition : si le nom du fichier commence par "JournalActionsRoulement"
        FN = Split(Mid(F.Name, 25), ".")(0) 'définit la fin du nom FN (date et heure)
        DSer = DateSerial(Year(Split(FN, "_")(0)), Month(Split(FN, "_")(0)), Day(Split(FN, "_")(0))) 'définit le numero de série de la date DSer
        HSer = TimeSerial(Split(Split(FN, "_")(1), "-")(0), Split(Split(FN, "_")(1), "-")(1), Split(Split(FN, "_")(1), "-")(2)) 'définit le numéro de série de l'heure HSer
        DeH = DSer & " " & HSer 'définit la date et l'heure DeH
        If DeH > Max Then Max = DeH: NF = F.Name 'si Deh est supérieure à Max (qui au départ vaut 0), définit la variable Max et le nom du fichier NF
    End If 'fin de la condition
Next F 'prochain fichier de la boucle
Set CS = Workbooks.Open(CA & "\" & NF) 'définit la classeur source CS (ayant NF comme nom) en l'ouvrant
Set OS = CS.Worksheets(1) 'définit l'onglet source OS
OS.Range("A8").Offset(1, 0).Copy OD.Range("A2") 'copy le tableau de l'onglet source à partir de A9 et le colle dans A2 de l'onglet destination
CS.Close False 'ferme le classeur source sans enregistrer les modifications
End Sub
Merci pour ta réponse

Il me met que cette ligne est non définie
1614266160039.png


Tu as peut-être oublié de déclarer OD ?
 

Robert

XLDnaute Barbatruc
Oui désolé comme je n'ai pas testé... Il manque un CurrentRegion.
Remplace :

VB:
OS.Range("A8").Offset(1, 0).Copy OD.Range("A2") 'copy le tableau de l'onglet source à partir de A9 et le colle dans A2 de l'onglet destination
par :
Code:
OS.Range("A8").CurrentRegion.Offset(1, 0).Copy OD.Range("A2") 'copy le tableau de l'onglet source à partir de A9 et le colle dans A2 de l'onglet destination
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, Cesar1275, Robert

Une autre façon de faire
(uniquement pour ce qui est d'ouvrir le classeur le plus récent d'un répertoire donné)
VB:
Sub Ouvrir_Le_Plus_Récent()
Dim Fic_XLS$, Récent_Fic$, LePlusRécent$, Répertoire$, r_Date As Date
Répertoire = "C:\Users\STAPLE\Documents\TESTS\" '<=: NE PAS OUBLIER le dernier Antislash!
Application.ScreenUpdating = False
Fic_XLS = Dir(Répertoire & "*.xls?")
If Fic_XLS <> vbNullString Then
    Récent_Fic = Fic_XLS
    r_Date = FileDateTime(Répertoire & Fic_XLS)
    Do While Fic_XLS <> ""
        If FileDateTime(Répertoire & Fic_XLS) > r_Date Then
        Récent_Fic = Fic_XLS
        r_Date = FileDateTime(Répertoire & Fic_XLS)
        End If
    Fic_XLS = Dir
    Loop
End If
LePlusRécent = Récent_Fic
Workbooks.Open Répertoire & LePlusRécent
End Sub
 

job75

XLDnaute Barbatruc
Bonsoir Cesar1275, Robert, JM,

On voit que les noms des fichiers à étudier sont établis de manière à ce que l'ordre chronologique corresponde à l'ordre alphabétique.

Il suffit d'ouvrir le dernier fichier trouvé par la fonction Dir qui cherche les fichiers par ordre alphabétique :
VB:
Sub Ouvrir()
Dim chemin$, fichier$, x$
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "JournalActionsRoulement_????-??-??_??-??-??.xlsx")
While fichier <> "": x = fichier: fichier = Dir: Wend
If x <> "" Then Workbooks.Open chemin & x Else MsgBox "Aucun fichier trouvé..."
End Sub
A+
 

job75

XLDnaute Barbatruc
Maintenant pour importer les valeurs utiliser ces macros du Module3 :
VB:
Sub Importer()
Dim F As Worksheet
Set F = Feuil1 'CodeName de la feuille de destination, à adapter
Application.ScreenUpdating = False
F.Range("A2:F" & F.Rows.Count).ClearContents 'RAZ
Ouvrir 'lance la macro
With ActiveWorkbook
    If .Name = ThisWorkbook.Name Then Exit Sub
    With .Sheets(1).[A8].CurrentRegion.Resize(, 6)
        If .Rows.Count > 1 Then _
            F.[A2].Resize(.Rows.Count - 1, 6) = .Offset(1).Resize(.Rows.Count - 1).Value 'copie les valeurs
    End With
    .Close False 'ferme le fichier
End With
End Sub

Sub Ouvrir()
Dim chemin$, fichier$, x$
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "JournalActionsRoulement_????-??-??_??-??-??.xlsx")
While fichier <> "": x = fichier: fichier = Dir: Wend
If x <> "" Then Workbooks.Open chemin & x Else MsgBox "Aucun fichier trouvé..."
End Sub
Téléchargez les fichiers joints dans le même dossier (le bureau).
 

Pièces jointes

  • Eléments supprimés(1).xlsm
    56.6 KB · Affichages: 6
  • JournalActionsRoulement_2021-02-24_10-08-43.xlsx
    11 KB · Affichages: 6

Cesar1275

XLDnaute Occasionnel
Oui désolé comme je n'ai pas testé... Il manque un CurrentRegion.
Remplace :

VB:
OS.Range("A8").Offset(1, 0).Copy OD.Range("A2") 'copy le tableau de l'onglet source à partir de A9 et le colle dans A2 de l'onglet destination
par :
Code:
OS.Range("A8").CurrentRegion.Offset(1, 0).Copy OD.Range("A2") 'copy le tableau de l'onglet source à partir de A9 et le colle dans A2 de l'onglet destination
Super ma macro fonctionne parfaitement maintenant !
 

Cesar1275

XLDnaute Occasionnel
Bonsoir le fil, Cesar1275, Robert

Une autre façon de faire
(uniquement pour ce qui est d'ouvrir le classeur le plus récent d'un répertoire donné)
VB:
Sub Ouvrir_Le_Plus_Récent()
Dim Fic_XLS$, Récent_Fic$, LePlusRécent$, Répertoire$, r_Date As Date
Répertoire = "C:\Users\STAPLE\Documents\TESTS\" '<=: NE PAS OUBLIER le dernier Antislash!
Application.ScreenUpdating = False
Fic_XLS = Dir(Répertoire & "*.xls?")
If Fic_XLS <> vbNullString Then
    Récent_Fic = Fic_XLS
    r_Date = FileDateTime(Répertoire & Fic_XLS)
    Do While Fic_XLS <> ""
        If FileDateTime(Répertoire & Fic_XLS) > r_Date Then
        Récent_Fic = Fic_XLS
        r_Date = FileDateTime(Répertoire & Fic_XLS)
        End If
    Fic_XLS = Dir
    Loop
End If
LePlusRécent = Récent_Fic
Workbooks.Open Répertoire & LePlusRécent
End Sub
Merci pour ta réponse, ton code fonctionne super bien ! Il me sera surement utile pour mes prochaines macros ;). Aurais-tu également un code qui permette de copier coller des données d'un tableau à un autre mais qui soit facilement adaptable ?
 

Cesar1275

XLDnaute Occasionnel
Maintenant pour importer les valeurs utiliser ces macros du Module3 :
VB:
Sub Importer()
Dim F As Worksheet
Set F = Feuil1 'CodeName de la feuille de destination, à adapter
Application.ScreenUpdating = False
F.Range("A2:F" & F.Rows.Count).ClearContents 'RAZ
Ouvrir 'lance la macro
With ActiveWorkbook
    If .Name = ThisWorkbook.Name Then Exit Sub
    With .Sheets(1).[A8].CurrentRegion.Resize(, 6)
        If .Rows.Count > 1 Then _
            F.[A2].Resize(.Rows.Count - 1, 6) = .Offset(1).Resize(.Rows.Count - 1).Value 'copie les valeurs
    End With
    .Close False 'ferme le fichier
End With
End Sub

Sub Ouvrir()
Dim chemin$, fichier$, x$
chemin = ThisWorkbook.Path & "\" 'à adapter
fichier = Dir(chemin & "JournalActionsRoulement_????-??-??_??-??-??.xlsx")
While fichier <> "": x = fichier: fichier = Dir: Wend
If x <> "" Then Workbooks.Open chemin & x Else MsgBox "Aucun fichier trouvé..."
End Sub
Téléchargez les fichiers joints dans le même dossier (le bureau).
Merci pour ta réponse !

Je ne comprend pas ce qu'il faut adapter dans ton code lorsque tu met : chemin = ThisWorkbook.Path & "\" 'à adapter ?
 

Cesar1275

XLDnaute Occasionnel
Bonjour Cesar1275,

ThisWorkbook.Path & "\" c'est le dossier du fichier .xlsm qui contient la macro.

Si les fichiers sources .xlsx sont dans un autre dossier il faut adapter en écrivant le chemin en dur.

A+
D'accord mais étant donné que je m'y connais assez peu; je ne sais pas comment écrire le chemin en dur ?
1614336965631.png

J'ai écrit le chemin mais il me met une erreur en jaune. J'utilise ton code pour une macro dans un fichier différent de celui dont je parlait au début de la discussion.
 

Discussions similaires