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
job75

job75

XLDnaute Barbatruc
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).
Cliquez pour agrandir...
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 !
Cliquez pour agrandir...
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: 4
  • Suivi_Qualité_ICV_210301_lignes.xlsx
    11 KB · Affichages: 5
Vote positif 0 Vote négatif
C

Cesar1275

XLDnaute Occasionnel
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+
Cliquez pour agrandir...
La macro fonctionne, mais au lieu de supprimer les lignes avec les N° 19 et 149, elle ne garde au contraire que celles-ci.
 
Vote positif 0 Vote négatif
C

Cesar1275

XLDnaute Occasionnel
job75 à dit:
Cette remarque ne correspond à rien, voyez les résultats obtenus sur le fichier (3) !!!
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
C

Cesar1275

XLDnaute Occasionnel
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 !
Cliquez pour agrandir...
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
 
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
771
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

2 membres et 52 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 105
dernier inscrit
Joffrette