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

Robert à dit:

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

Cliquez pour agrandir...

Robert à dit:

9Oui pardon il manque un Set devant :

Sass:

Set OD = CD.Worksheets(1)

Cliquez pour agrandir...

Robert à dit:

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

Cliquez pour agrandir...

Staple1600 à dit:

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

Cliquez pour agrandir...

job75 à dit:

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).

Cliquez pour agrandir...

Cesar1275 à dit:

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

Cliquez pour agrandir...

job75 à dit:

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+

Cliquez pour agrandir...

job75 à dit:

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

Cliquez pour agrandir...