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

C

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: 22
  • Eléments supprimés.xlsm
    51.9 KB · Affichages: 8
Solution
Robert
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
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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
 
Vote positif 0 Vote négatif
C

Cesar1275

XLDnaute Occasionnel
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...
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 ?
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
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
 
Vote positif 0 Vote négatif
Solution
Staple1600

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
 
Vote positif 0 Vote négatif
job75

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+
 
Vote positif 0 Vote négatif
job75

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
Vote positif 0 Vote négatif
C

Cesar1275

XLDnaute Occasionnel
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...
Super ma macro fonctionne parfaitement maintenant !
 
Vote positif 0 Vote négatif
C

Cesar1275

XLDnaute Occasionnel
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...
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 ?
 
Vote positif 0 Vote négatif
C

Cesar1275

XLDnaute Occasionnel
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...
Merci pour ta réponse !

Je ne comprend pas ce qu'il faut adapter dans ton code lorsque tu met : chemin = ThisWorkbook.Path & "\" 'à adapter ?
 
Vote positif 0 Vote négatif
C

Cesar1275

XLDnaute Occasionnel
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...
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.
 
Vote positif 0 Vote négatif

Discussions similaires

R
  • Résolu(e)
Microsoft 365 VBA Création dossier + sous dossier + enregistrer le fichier dans le dossier
2
Réponses
17
Affichages
769
raf26
R
M
  • Question
XL 2021 Creation VBA copie de differents fichiers dans différents dossiers
Réponses
5
Affichages
327
patricktoulon
patricktoulon
P
  • Question
Microsoft 365 VBA - Enregistrer un fichier en pdf dans un dossier dont on ne connait que les 4 premiers caractères
Réponses
2
Affichages
388
phil75016
P
E
  • Question
XL 2013 Excel VBA - Problème lien hypertexte pour ouvrir un dossier
2
Réponses
19
Affichages
1 K
TooFatBoy
TooFatBoy
K
  • Résolu(e)
Microsoft 365 Ouvrir un autre classeur excel (VBA) pour utiliser les données de celui dans le classeur actif
Réponses
5
Affichages
1 K
Dranreb
Dranreb
F
  • Question
Microsoft 365 comment ouvrir en lecture/écriture un fichier EXCEL placé sous sharepoint
Réponses
2
Affichages
788
fibled
F
N
  • Résolu(e)
Microsoft 365 Je ne peux plus ouvrir mon fichier Excel sur Mac
Réponses
11
Affichages
885
Ben66
B
L
  • Question
Microsoft 365 Changer le nom d'un fichier dans un lien par un autre lien
Réponses
9
Affichages
576
Phil69970
Phil69970
C
  • Question
XL 2013 Insérer un fichier texte dans un dossier
Réponses
4
Affichages
488
coline741
C
A
  • Question
XL 2019 Copier une plage dans un fichier fermé en VBA
2
Réponses
21
Affichages
2 K
Amilo
A

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 67 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 104
dernier inscrit
JEMADA