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

Cesar1275

XLDnaute Junior
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: 8
  • Eléments supprimés.xlsm
    51.9 KB · Affichages: 6
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

job75

XLDnaute Barbatruc
Bonjour Cesar1275, Robert, le forum,
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.
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+
 

Pièces jointes

  • Eléments supprimés(3).xlsm
    26.5 KB · Affichages: 3
  • Suivi_Qualité_ICV_210301_lignes.xlsx
    11 KB · Affichages: 4

Cesar1275

XLDnaute Junior
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.
 

Cesar1275

XLDnaute Junior
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.

1614759478705.png
 

Cesar1275

XLDnaute Junior
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
 

Discussions similaires

Haut Bas