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

Cesar1275 · 25 Février 2021

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

Robert · 25 Février 2021

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

job75 · 2 Mars 2021

Bonjour Cesar1275, Robert, le forum,

Cesar1275 à dit:
En fait les doublons sont caractérisés par des numéros de trains identiques dans les colonnes F des 2 tableaux (Eléments supprimés et JournalActionsRoulement).

C'est assez curieux mais bon voyez la macro ci-dessous.

Cesar1275 à dit:
Ta macro fonctionne et colle bien les données dans la feuille "restauration" comme je le voulais !

Il n'a jamais été question de coller des données dans la feuille Restauration qui n'est là que pour les doublons.

VB:

Sub Importer()
Dim d As Object, tablo, x$, v&, i&, F As Worksheet
'---liste sans doublon des numéros de train---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Sheets("Restauration").[A1].CurrentRegion.Columns(6).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 2 To UBound(tablo)
    x = tablo(i, 1)
    v = Val(Mid(x, InStr(x, "train") + 5))
    If v = 0 Then v = Val(Mid(x, InStr(x, "étape") + 5))
    If v Then d(v) = ""
Next
'---traitement et copie du fichier source---
Set F = Sheets("Données") 'à adapter
Application.ScreenUpdating = False
F.Range("A4:F" & F.Rows.Count).Delete xlUp 'RAZ
Ouvrir 'lance la macro
With ActiveWorkbook
    If .Name = ThisWorkbook.Name Then Exit Sub
    With .Sheets(1).[A8].CurrentRegion
        tablo = .Columns(6).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
        For i = UBound(tablo) To 2 Step -1
            x = tablo(i, 1)
            v = Val(Mid(x, InStr(x, "train") + 5))
            If v = 0 Then v = Val(Mid(x, InStr(x, "étape") + 5))
            If InStr(x, "train 19") Or InStr(x, "étape 19") Or InStr(x, "train 149") Or InStr(x, "étape 149") _
                Or d.exists(v) Then .Rows(i).Delete xlUp
        Next
        If .Rows.Count > 1 Then
            F.[A4].Resize(.Rows.Count - 1, 6) = .Offset(1).Resize(.Rows.Count - 1, 6).Value 'copie les valeurs
            F.[A2:F3].AutoFill F.[A2].Resize(.Rows.Count + 1, 6), xlFillFormats 'tire les formats
        End If
    End With
    .Close False 'ferme le fichier
End With
End Sub

Sub Ouvrir()
Dim chemin$, fichier$, x$
chemin = "C:\Users\0017475V\Documents\ICV - HRE\Données\" 'à adapter
'chemin = ThisWorkbook.Path & "\" 'pour tester plus facilement chez moi...
fichier = Dir(chemin & "Suivi_Qualité_ICV_??????_lignes.xlsx")
While fichier <> "": x = fichier: fichier = Dir: Wend
If x <> "" Then Workbooks.Open chemin & x Else MsgBox "Aucun fichier trouvé..."
End Sub

A+

Cesar1275 · 2 Mars 2021

job75 à dit:

Bonjour Cesar1275, Robert, le forum,

C'est assez curieux mais bon voyez la macro ci-dessous.

Il n'a jamais été question de coller des données dans la feuille Restauration qui n'est là que pour les doublons.

VB:

Sub Importer()
Dim d As Object, tablo, x$, v&, i&, F As Worksheet
'---liste sans doublon des numéros de train---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Sheets("Restauration").[A1].CurrentRegion.Columns(6).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 2 To UBound(tablo)
    x = tablo(i, 1)
    v = Val(Mid(x, InStr(x, "train") + 5))
    If v = 0 Then v = Val(Mid(x, InStr(x, "étape") + 5))
    If v Then d(v) = ""
Next
'---traitement et copie du fichier source---
Set F = Sheets("Données") 'à adapter
Application.ScreenUpdating = False
F.Range("A4:F" & F.Rows.Count).Delete xlUp 'RAZ
Ouvrir 'lance la macro
With ActiveWorkbook
    If .Name = ThisWorkbook.Name Then Exit Sub
    With .Sheets(1).[A8].CurrentRegion
        tablo = .Columns(6).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
        For i = UBound(tablo) To 2 Step -1
            x = tablo(i, 1)
            v = Val(Mid(x, InStr(x, "train") + 5))
            If v = 0 Then v = Val(Mid(x, InStr(x, "étape") + 5))
            If InStr(x, "train 19") Or InStr(x, "étape 19") Or InStr(x, "train 149") Or InStr(x, "étape 149") _
                Or d.exists(v) Then .Rows(i).Delete xlUp
        Next
        If .Rows.Count > 1 Then
            F.[A4].Resize(.Rows.Count - 1, 6) = .Offset(1).Resize(.Rows.Count - 1, 6).Value 'copie les valeurs
            F.[A2:F3].AutoFill F.[A2].Resize(.Rows.Count + 1, 6), xlFillFormats 'tire les formats
        End If
    End With
    .Close False 'ferme le fichier
End With
End Sub

Sub Ouvrir()
Dim chemin$, fichier$, x$
chemin = "C:\Users\0017475V\Documents\ICV - HRE\Données\" 'à adapter
'chemin = ThisWorkbook.Path & "\" 'pour tester plus facilement chez moi...
fichier = Dir(chemin & "Suivi_Qualité_ICV_??????_lignes.xlsx")
While fichier <> "": x = fichier: fichier = Dir: Wend
If x <> "" Then Workbooks.Open chemin & x Else MsgBox "Aucun fichier trouvé..."
End Sub

A+

La macro fonctionne, mais au lieu de supprimer les lignes avec les N° 19 et 149, elle ne garde au contraire que celles-ci.

job75 · 2 Mars 2021

Cesar1275 à dit:
La macro fonctionne, mais au lieu de supprimer les lignes avec les N° 19 et 149, elle ne garde au contraire que celles-ci.

Cette remarque ne correspond à rien, voyez les résultats obtenus sur le fichier (3) !!!

Cesar1275 · 3 Mars 2021

job75 à dit:
Cette remarque ne correspond à rien, voyez les résultats obtenus sur le fichier (3) !!!

La macro ne copie pas les bonnes données comme vous pouvez le voir.
Je vais réussir à me débrouiller par moi-même.
Merci pour votre aide malgré tout.

job75 · 3 Mars 2021

Cesar1275 à dit:
La macro ne copie pas les bonnes données comme vous pouvez le voir.

Arrêtez de bricoler les codes qu'on vous donne, ça ira mieux.

Car vous n'arrêtez pas : au post #32 vous parliez des trains 19 et 149, maintenant on ne les voit plus !

Cesar1275 · 3 Mars 2021

job75 à dit:
Arrêtez de bricoler les codes qu'on vous donne, ça ira mieux.

Car vous n'arrêtez pas : au post #32 vous parliez des trains 19 et 149, maintenant on ne les voit plus !

Ma demande est trop complexe pour être traitée correctement sur un forum j'ai l'impression.
Il est parfois difficile d'expliquer exactement ce que l'on veut.
Pour ce qui est de la dernière macro, je ne l'ai absolument pas modifié et elle ne fonctionne pas malgré tout.

Bonne continuation

job75 · 3 Mars 2021

Cesar1275 à dit:
Ma demande est trop complexe pour être traitée correctement sur un forum j'ai l'impression.

Elle n'est pas complexe et je vous ai toujours donné des codes assez faciles à comprendre.

Vous ne bricolez pas ? Alors pourquoi y a-t-il des nombres dans la colonne "Action" au post #34 ???

Dans tous vos fichiers sources ce sont des textes assez longs !!!

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

Cesar1275

XLDnaute Occasionnel

Pièces jointes

Robert

job75

XLDnaute Barbatruc

Pièces jointes

Cesar1275

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

Cesar1275

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Cesar1275

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Discussions similaires