Extraction d'Excel vers un autre par rapport au fichier le plus récent

Bonjour à vous,

je suis en master 1 et j'ai un petit souci,

Je vous expose mon problème :

Je dois faire une macro qui permet d'extraire certaines données du Excel B ( InventaireGeneral) vers l'Excel A( PROJET TRANSFERT DE STOCK 2) . (Le bouton est exécuté dans le Excel A)
La particularité est que l'extraction doit être faite par rapport au fichier le plus récent à chaque lancement de la macro.

Il faut noter que dans la macro il y'a :

- Dans le Excel B= un tri des données du tableau concerné, une sélection de zone (exemple : 061) puis une copie ( shift + ctrl + fleche de droite + fleche du bas)

- Dans le Excel A = Un collage des informations dans un tableau qui a été copié depuis le Excel B.

Comme vous pouvez voir ci-dessous l'extraction doit se faire par rapport au Excel le plus récent, pour aujourd'hui cela serait le 17/03/2022, ainsi de suite...

Sub NewestFile()

Dim Mypath As String
Dim Myfil As String
Dim MyLatestFile As String
Dim LatestDate As Date
Dim LMD As Date

Mypath = "C:\Users\tmermier\Desktop\Oracle\ExportRequete\InventaireGeneral.xls\"
i = FileDateTime(Mypath & FName)
If Right(Mypath, 1) <> "\" Then Mypath = Mypath & "\"
Myfile = Dir(Mypath & ".xls", vbNormal)
If Len(Myfile) = 0 Then
MsgBox " Aucun fichier n'a été trouvé...", vbExclamation
Exit Sub
End If
Do While Len(Myfile) > 0
If LMD > LatestDate Then
LatestFile = Myfile
LatestDate = LMD
End If
Myfile = Dir
Loop

Mypath = "C:\Users\tmermier\Desktop\Oracle\ExportRequete\InventaireGeneral.xls\"
Workbooks.Open Mypath & LatestFile
Sheets("Valo").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.AutoFilter
ActiveSheet.Range("$A$3:$J$5000").AutoFilter Field:=1, Criteria1:="061"
Range("C30").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Workbooks.Open Filename:

Windows("PROJET TRANSFERT DE STOCK EXCEL 2.xlsm").Activate

Sheets("feuil1").Select
ActiveSheet.Range("E23").Select
MsgBox "Les données ont été extraites avec succès"

End Sub

En vous remerciant amplement

Bonjour

Pour ouvrir le bon classeur. A adapter bien sûr.

Sub Extraire()
  Dim Mypath As String
  Dim Myfil As String
  Dim MyLatestFile As String
  Dim LMD 'As Date

  Dim x, y, z

  Mypath = "C:\Users\yal\Documents\tmp excel\Excel pratique\ theo_mrm\Semaine 10 année 2022\"

  Myfil = Dir(Mypath)
  Do While Myfil <> ""
    x = CDate(Right(Left(Split(Myfil, "_")(1), 8), 2) & "/" & _
      Mid(Left(Split(Myfil, "_")(1), 8), 5, 2) & _
      "/" & Left(Left(Split(Myfil, "_")(1), 8), 4))
    If x > LMD Then
      LMD = x
      MyLatestFile = Myfil
    End If
    Myfil = Dir
  Loop
  Workbooks.Open Mypath & MyLatestFile

End Sub

Bonjour Yal,

Le dossier "ExportRequete" comporte les nouveaux excel extrait grâce a ma macro VBsript. L'autre dossier que vous avez mentionné dans le path "semaine 10 année 2022" correspond au archive de mes Excel n-1. Du coup la recherche doit être faite dans mon dossier "ExportRequete" car automatiquement les Excel extrait son mis dans le dossier "Exportrequete" et renommer a la date du jour de l'extraction.

Du coup j'ai déplacer les archives dans un dossier a part pour pas tous mélangé.

Concernant le codage

Sub NewestFile()

    Dim Mypath As String
    Dim Myfil As String
    Dim MyLatestFile As String
    Dim LMD 'As Date

    Dim x, y, z

    Mypath = "C:\Users\tmermier\Desktop\Oracle\ExportRequete\"

  Myfil = Dir(Mypath)
  Do While Myfil <> ""
    x = CDate(Right(Left(Split(Myfil, "_")(1), 8), 2) & "/" & _
      Mid(Left(Split(Myfil, "_")(1), 8), 5, 2) & _
      "/" & Left(Left(Split(Myfil, "_")(1), 8), 4))
    If x > LMD Then
      LMD = x
      MyLatestFile = Myfil
    End If
    Myfil = Dir
  Loop
  Workbooks.Open Mypath & MyLatestFile

    Mypath = "C:\Users\tmermier\Desktop\Oracle\ExportRequete\"

    Workbooks.Open Mypath & LatestFile
    Sheets("Valo").Select
    Range(Selection, Selection.End(xlToRight)).Select
        Selection.AutoFilter
    ActiveSheet.Range("$A$3:$J$5000").AutoFilter Field:=1, Criteria1:="061"
    Range("C30").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    Workbooks.Open Filename:

    Windows("PROJET TRANSFERT DE STOCK EXCEL 2.xlsm").Activate
    Sheets("feuil1").Select
    ActiveSheet.Range("E23").Select
MsgBox "Les données ont été extraites avec succès"

End Sub

j'ai une erreur ligne 21 " Workbooks.Open Mypath & MyLatestFile"

Mais cela concerne l'exécution de la macro extraction Excel vers Excel.

Mais en tout cas j'ai refait le codage grâce au votre et cela m'ouvre bien le dernier excel. Je vous remercie énormément pour la premier partie !!!

De ce que je vois vous ouvrez deux fois le même fichier. C'est sûr que ça ne marche pas.

d'accord merci.