Copier repertoire vers classeur

M'enfin, ta macro va chercher le dernier de la liste. Mais as-tu pensé à quel ordre respectait la fonction ?
- Alphabétique,
- Date de création,
- Date de dernière modification,
- Emplacement physique sur le disque,
- Aléatoire.

Bon, comme ça fait longtemps que tu ne me fais plus de messages bien horrible, t'as droit à un cadeau. Le code tout fait pour connaître le plus vieux fichier d'un répertoire :

Option Explicit
 
Function NomPlusVieuxFichier(chemin As String) As String
    Dim fso                As FileSystemObject
    Dim fichier            As File
    Dim plus_vieux_fichier As File
 
    Set fso = CreateObject("scripting.filesystemobject")
    For Each fichier In fso.GetFolder(chemin).Files
        If plus_vieux_fichier Is Nothing Then
            Set plus_vieux_fichier = fichier
        ElseIf fichier.DateLastModified < plus_vieux_fichier.DateLastModified Then
            Set plus_vieux_fichier = fichier
        End If
    Next
 
    ' // Résultat
    If plus_vieux_fichier Is Nothing Then
        NomPlusVieuxFichier = ""
    Else
        NomPlusVieuxFichier = plus_vieux_fichier.Path
    End If
End Function

T'as plus qu'à adapter pour connaître le plus jeune, tout en me maudissant de ne pas te l'avoir fait moi-même

---------

EDIT: Oups, j'allais oublier.
Pour que ça marche chez toi, il faut que tu déclares la référence à Microsoft Scripting Runtime de la bibliothèque scrrun.dll.
Trois solutions si tu ne comprends rien à ça :
1°) Tu cherches et trouves par toi-même (+10)  
2°) Tu me demandes de bien te l'expliquer (~0)  
3°) Tu remplaces les types spécifiques par des objets neutres (-1)  

Dim fso                As Object
Dim fichier            As Object
Dim plus_vieux_fichier As Object

merci bien je suis entrain de faire la recherche

 

Bonjour Zeb et a tous  
j'ai lu ton code avec le bouton f1 j'essai de comprendre d'abord les fonctions que tu utilise et a quoi elle servent enfin svoir ce que fait ton code je crois que c'est a partir de ce moment que je peux facilement trouver comment ecrire celui du plus jeune fichier .
je vais reprendre ton code ligne par ligne et te dire comment je le comprend aussi te faire savoir ce qui me parrait flou :
*au tout debut on a une option explicite c'est pour déclarer toutes les variables de façon explicite "j'ai compris"
**entre la ligne 3 et la ligne 23 si je ne me trompe pas c'est une fonction que tu a defini ...
***

Dim fso                As FileSystemObject

fso c'est une variable de type "FileSystemObject" mais FileSystemObject represente quel genre de variable la j'ai pas compris
****

Dim fichier            As File

         Dim plus_vieux_fichier As File

ça c'est compri tu as defini des variables de type fichier ...

****

Set fso = CreateObject("scripting.filesystemobject" )

        For Each fichier In fso.GetFolder(chemin).Files

voici la derniere chose qui me parrait dur a saisir si tu pouvais m'expliquer ligne par ligne .
au fait CreateObject: creé et renvoi une reference a un objet ça j'ai pu le voir dans l'aide ..

voila pour le code mais j'ai une interrogation  

sur mon ordi il y a plusieurs fichiers dans des repertoires differents comment le code que tu m'a envoyé c'est faire ce que je veux c'est a dire suivre le chemin :

sRépertoire = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Synthèse\"denier fichier"

   

merci bien d'avance

Le VBA , c'est du VB avec un certain nombre de modules en moins.
Pour le VBA/Excel, on met VBA basic + les objets Excel.
Pour le VBA/Word, on met VBA basic + les objets Word.

Donc de façon logique, quand tu fais du VBA sous Excel, les objets Excel sous déjà chargés.

Imagine que tu veuilles écrire une page Word dans Excel. Ben c'est impossible de le faire puisque le VBA/Excel ne connaît pas les objets Word. Sauf si on charge les références Word dans VBA/Excel. La liste des références possible dépend de ce qu'il y a installé sur ton poste.

Dans l'éditeur de VBA; ouvre le menu Outils/Références.... Et oui, tu peux charger tout ça !

VBA par défaut, n'est pas capable de gérer les objets de base comme les répertoires, les fichiers  

Mais comme VB est un langage permissif, si tu fais

Dim fso As Object

Set fso = CreateObject("scripting.filesystemobject" )

ca marche quand même.

Moi, j'aime à savoir ce que je fais. Alors je déclare la référence pour FileSystemObject et File. Bon, faut être un gros malin (je suis un gros malin   ) pour savoir dans quelles références se planquent ces objets. C'est dans une seule et même référence Microsoft Scripting Runtime. Sauf que la liste Références - VBA Project ne te le propose pas toujours. Dans ce cas, il faut est un encore plus gros malin, et savoir que Microsoft Scripting Runtime est le nom d'exploitation d'une bibliothèque de liens dynamiques qui se nomme scrrun.dll. On clique alors sur [Parcourir] et on va la chercher sans %windir%\system32.

Et voilà, maintenant VBA/Excel ressemble un peu plus à VB tout court. Sauf que les objets chargés par défaut ne sont pas les mêmes.

Par exemple, VBA/Excel charge un objet Application qui représente l'instance d'Excel chargée. VB ne charge pas d'instance Excel, il faudrait le faire à la main, comme ça :

Set appxl = CreateObject("Application.Excel" )

Bon, ben t'as compris. VBA/Excel ne charge pas l'objet FileSystemObject. Faut le faire à la main  

Set fso = CreateObject("scripting.filesystemobject" )

Grâce aux nouveaux objets contenu dans cette référence, je vais pouvoir facilement lire les dates de dernière modification de chaque fichier, et les comparer pour ne garder que le plus vieux. Etuide bien mon programme, c'est ce qu'il fait.

Voilà.

bonjour tout le monde
desolé de te decevoir une fois de plus Zeb mais j'arrive a rien .......  

en plus je n'arrive pas a executer ton code j'ai mi :

sub toto()

1.Option Explicit

2.

3.Function NomPlusVieuxFichier(chemin As String) As String

.

.

.

end function

 
end sub

comment faire ??  

merci de l'aide

 

Suffit de changer Vieux par Jeune et < par > dans mon code !

merci
j'ai la tete dur ....ça c pas faut
mais il y un soucis j'ai ajouté
sub toto() avant function
end sub apres end function
mais je n'arrive pas a executer le code comment faire
desolé d'etre aussi nul  

M'enfin !

Je te donne le code d'une fonction. C'est une fonction. Picétou.
T'as fait des maths à l'école ? Quand tu as une fonction f(x), elle ne fait rien toute seule la fonction f(x). Il faut l'appeler avec des x et elle te renvoie des y.

Pareille pour NomPlusVieuxFichier.
Tu l'appelles avec un chemin, elle te renvoie un nom de fichier.

Function NomPlusVieuxFichier(chemin As String) As String

    ...

End Function

 
' // C'est pas de moi, le nom de la procédure, hein !

Sub Toto

    MsgBox "Le fichier le plus ancien du répertoire C:\ est : " & NomPlusVieuxFichier("C:\")

End Sub

bonjour Zeb ,et bonjour tout le monde , voila j'ai adapté le code selon mon chemein
et ça donne ceci:

Option Explicit

 
Function NomPlusJeuneFichier(Chemin As String) As String

    Dim Fso                As FileSystemObject

    Dim Fichier            As File

    Dim plus_Jeune_fichier As File

 
    Set Fso = CreateObject("scripting.filesystemobject")

    For Each Fichier In Fso.GetFolder(Chemin).Files

       If plus_Jeune_fichier Is Nothing Then

            Set plus_Jeune_fichier = Fichier

        ElseIf Fichier.DateLastModified > plus_Jeune_fichier.DateLastAccessed Then

            Set plus_Jeune_fichier = Fichier

        End If

    Next

 
    ' // Résultat

    If plus_Jeune_fichier Is Nothing Then

        NomPlusJeuneFichier = ""

    Else

        NomPlusJeuneFichier = plus_Jeune_fichier.Path

    End If

End Function

Sub toto()

    Dim Chemin As String

 Chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Synthèse"

 MsgBox "Le fichier le plus NOUVEAU du répertoire S:\ est : " & NomPlusJeuneFichier(Chemin)

End Sub

le code fonctionne bien mais il y a un problème   la boite de dialogue me donne l'avant dernier fichier du dossier synthese c'est a dire celui du 29/06/2010 au lieu de celui du 30/06/2010
comment y remedier?

merci

hé Zeb quoi tu m'a abandonné ce apres midi?
bon voila sache que je ne dors pas je fouille alors j'ai pu faire ceci :

Function NomPlusJeuneFichier(Chemin As String) As String

    Dim Fso                As FileSystemObject

    Dim Fichier            As File

    Dim plus_Jeune_fichier As File

    Dim LaDate As Date, DatePlusJeuneFichier As Date

 
    Set Fso = CreateObject("scripting.filesystemobject")

    For Each Fichier In Fso.GetFolder(Chemin).Files

       If plus_Jeune_fichier Is Nothing Then

            Set plus_Jeune_fichier = Fichier

            DatePlusJeuneFichier = CDate(Left(Fichier.Name, InStr(1, Fichier.Name, " ") - 1))

        Else

            LaDate = CDate(Left(Fichier.Name, InStr(1, Fichier.Name, " ") - 1))

            If LaDate > DatePlusJeuneFichier Then

                DatePlusJeuneFichier = LaDate

                Set plus_Jeune_fichier = Fichier

            End If

        End If

    Next

 
    ' // Résultat

  If plus_Jeune_fichier Is Nothing Then

        NomPlusJeuneFichier = ""

    Else

        NomPlusJeuneFichier = plus_Jeune_fichier.Path

    End If

End Function

    Sub toto_1()

    Dim Chemin As String

    Dim k As Long

    k = Worksheets("Feuil2").Cells(Rows.Count, 7).End(xlUp).Row

    Chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Synthèse"

 
     MsgBox "Le fichier le plus récent du répertoire S:\ est : " & NomPlusJeuneFichier(Chemin)

 
    End Sub

là la boite de dialogue me dit bien que le fichier le plus recent est celui du 30/06/2010
mais il reste une chose a faire aller a la feuille("synthèse") du classeur le plus recent et copier les valeurs H32 et D32
puis coller lces valeurs dans la premeire celulle vide respectivement en collone I et G
ALORS j'ai ajouté a la ligne 33 ceci:

Workbooks("Classeurvarpara&hist").Worksheets("Feuil2").Cells(k + 1, "G").Value = _

    Workbooks("NomPlusJeuneFichier").Worksheets("Synthèse").Cells(32, "D").Value

    Workbooks("Classeurvarpara&hist").Worksheets("Feuil2").Cells(k + 1, "I").Value = _

    Workbooks("NomPlusJeuneFichier").Worksheets("Synthèse").Cells(32, "H").Value

et ça donne en tout :

Function NomPlusJeuneFichier(Chemin As String) As String

    Dim Fso                As FileSystemObject

    Dim Fichier            As File

    Dim plus_Jeune_fichier As File

    Dim LaDate As Date, DatePlusJeuneFichier As Date

 
    Set Fso = CreateObject("scripting.filesystemobject")

    For Each Fichier In Fso.GetFolder(Chemin).Files

       If plus_Jeune_fichier Is Nothing Then

            Set plus_Jeune_fichier = Fichier

            DatePlusJeuneFichier = CDate(Left(Fichier.Name, InStr(1, Fichier.Name, " ") - 1))

        Else

            LaDate = CDate(Left(Fichier.Name, InStr(1, Fichier.Name, " ") - 1))

            If LaDate > DatePlusJeuneFichier Then

                DatePlusJeuneFichier = LaDate

                Set plus_Jeune_fichier = Fichier

            End If

        End If

    Next

 
    ' // Résultat

  If plus_Jeune_fichier Is Nothing Then

        NomPlusJeuneFichier = ""

    Else

        NomPlusJeuneFichier = plus_Jeune_fichier.Path

    End If

End Function

    Sub toto_1()

    Dim Chemin As String

    Dim k As Long

    k = Worksheets("Feuil2").Cells(Rows.Count, 7).End(xlUp).Row

    Chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Synthèse"

    Workbooks("Classeurvarpara&hist").Worksheets("Feuil2").Cells(k + 1, "G").Value = _

    Workbooks("NomPlusJeuneFichier").Worksheets("Synthèse").Cells(32, "D").Value

    Workbooks("Classeurvarpara&hist").Worksheets("Feuil2").Cells(k + 1, "I").Value = _

    Workbooks("NomPlusJeuneFichier").Worksheets("Synthèse").Cells(32, "H").Value

     MsgBox "Le fichier le plus récent du répertoire S:\ est : " & NomPlusJeuneFichier(Chemin)

 
    End Sub

mais j'ai une erreur ''l'indice n'appartient pas a la selection '' a la ligne 33

merci de me venir en aide.

bonjour tout le monde voici une proposition de solution:

Function NomPlusJeuneFichier(Chemin As String) As String

    Dim Fso                As FileSystemObject

    Dim Fichier            As File

    Dim plus_Jeune_fichier As File

    Dim LaDate As Date, DatePlusJeuneFichier As Date

 
    Set Fso = CreateObject("scripting.filesystemobject")

    For Each Fichier In Fso.GetFolder(Chemin).Files

       If plus_Jeune_fichier Is Nothing Then

            Set plus_Jeune_fichier = Fichier

            DatePlusJeuneFichier = CDate(Left(Fichier.Name, InStr(1, Fichier.Name, " ") - 1))

        Else

            LaDate = CDate(Left(Fichier.Name, InStr(1, Fichier.Name, " ") - 1))

            If LaDate > DatePlusJeuneFichier Then

                DatePlusJeuneFichier = LaDate

                Set plus_Jeune_fichier = Fichier

            End If

        End If

    Next

 
    ' // Résultat

  If plus_Jeune_fichier Is Nothing Then

        NomPlusJeuneFichier = ""

    Else

        NomPlusJeuneFichier = plus_Jeune_fichier.Name

    End If

End Function

 
Sub recherche_var()

 
Dim LeChemin As String, LaFeuille As String, LeFichier As String

Dim LaCellule

Dim Tblo

k = Worksheets("Feuil2").Cells(Rows.Count, 7).End(xlUp).Row

Tblo = Array("D32", "H32")

LeChemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Synthèse"

LeFichier = NomPlusJeuneFichier(LeChemin)

LaFeuille = "Synthèse"

For Each LaCellule In Tblo

    With Sheets("Feuil2").[G65000].End(xlUp)(2)

        .FormulaArray = "='" & LeChemin & "\[" & LeFichier & "]" & LaFeuille & "'!" & LaCellule

        .Value = .Value

    End With

Next LaCellule

Sheets("Feuil2").Cells(k + 1, "I").Value = Sheets("Feuil2").Cells(k + 2, "G").Value

Sheets("Feuil2").Cells(k + 2, "G").Value = ""

End Sub

merci beaucoup a vous tous  

Oups. Erreur détectée dans MON code  

A la ligne 12 de ce code : http://www.presence-pc.com/forum/ppc/Programmation/copi... , il y avait écrit

If Fichier.DateLastModified > plus_Jeune_fichier.DateLastAccessed Then

Evidemment, il fallait lire :

If Fichier.DateLastModified > plus_Jeune_fichier.DateLastModified Then

Mea culpa.

Et non, je ne t'ai pas abandonné, cher ami, j'ai juste pris l'après-m' pour m'envoyer en l'air. (*)

L'erreur correspond à un indice de collections.
Ligne 33, tu as trois collections :

Workbooks,

Worksheets,

Cells.

Il va te falloir débugger ça pour savoir lequel pose problème.
L'art de déboguer : http://www.presence-pc.com/forum/ppc/Programmation/exce...

______________
(*) Comprenne qui pourra  

voila je vais apprendre le debogage ce week end ,je croi que le resultat que j'ai posté avant la derniere intervention de Zeb repond a la question que je voulais resoudre jusque là.

,je continu dans ce sujet car c'est quelque chose de similaire que je fais mais avec une legere difference :


je voudrai suivre un chemin qui n'est rien d'autre que clui là:
Chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO suivi quotidien\Résultat économique"
le problème est que le dossier "Résultat économique" contient plusieurs fichiers de noms differents
mais moi ceux qui m'interressent ce sont ceux nommés par exemple :20100701-résultat economique ,20100701 c'est en fait la date d'hier c'est donc le fichier le plus recent de nom:"20100701-résultat economique "
un nouveau fichier est completé chaque jour de date égale a la date du jour -1 .
mois je voudrai donc allez dans ce dernier fichier et copier la derniere ligne non vide de l'onglet ("Historik") puis mettre cette ligne a la derniere ligne vide de mon classeur "varpara" a la feuille "feuil1"

j'ai donc fait comme ci-dessous mais ça ne marche pas si quelqu'un veut bien me'aider pour que le code aille tout simplement dans le fichier le plus recent de nom du type "20100701-résultat economique " sachant qu'il y a d'autres fichiers dans le dossier ,
tous les fichiers du dossier commence par la date comme indiqué plus haut

voici mon code :

Function NomPlusJeuneFichier(Chemin As String) As String

    Dim Fso                As FileSystemObject

    Dim Fichier            As File

    Dim plus_Jeune_fichier As File

    Dim LaDate As Date, DatePlusJeuneFichier As Date

    Dim X As String

 
    Set Fso = CreateObject("scripting.filesystemobject")

    For Each Fichier In Fso.GetFolder(Chemin).Files

        X = Val(Left(Fichier.Name, InStr(1, Fichier.Name, " ") - 1))

       If plus_Jeune_fichier Is Nothing Then

            Set plus_Jeune_fichier = Fichier

            DatePlusJeuneFichier = CDate(Left(X, 4) & "/" & Mid(X, 5, 2) & "/" & Right(X, 2))

        Else

            LaDate = CDate(Left(X, 4) & "/" & Mid(X, 5, 2) & "/" & Right(X, 2))

            If LaDate > DatePlusJeuneFichier Then

                DatePlusJeuneFichier = LaDate

                Set plus_Jeune_fichier = Fichier

            End If

        End If

    Next

 
    ' // Résultat

 If plus_Jeune_fichier Is Nothing Then

        NomPlusJeuneFichier = ""

    Else

        NomPlusJeuneFichier = plus_Jeune_fichier.Path

    End If

End Function

et :

Sub recherche_historik()

    Dim LeChemin As String, LaFeuille As String, LeFichier As String

    Dim LaCellule

    Dim i As Long

    Dim Tblo() As Double

    ReDim Tblo(0 To 27) 'tableau de la derniere ligne qui contient 28 cellule

    k = Worksheets("Feuil1").Cells(Rows.Count, 2).End(xlUp).Row + 1

    LeChemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Résultat économique"

    LeFichier = NomPlusJeuneFichier(LeChemin)

    LaFeuille = "Historik"

    For i = 0 To 27

        Tblo(i) = "='" & LeChemin & "\[" & LeFichier & "]" & LaFeuille & "'!" & Cells(k, i).Value

        Sheets("Feuil1").Cells(k, i).Value = Tblo(i)

 
    Next 

end sub

mais j'ai une erreur "argument ou appel de procedure incorrect" dans ma fonction a la ligne 10

aussi j'ai un grand doute dans mon
Sub recherche_historik()....

mais je vois pas du coup j'ai besoin de vous
merci

Je propose une nouvelle version de NomPlusJeuneFichier :

' // Charger Microsoft Scripting Runtime dans les références
' // C'est le fichier %windir%\system32\scrrun.dll
Function NomPlusJeuneFichier(Chemin As String, Optional PatternNomFichier As String) As String
    Dim FSO              As FileSystemObject
    Dim Fichier          As File
    Dim PlusJeuneFichier As File
 
    Set FSO = CreateObject("scripting.filesystemobject")
    For Each Fichier In FSO.GetFolder(Chemin).Files
 
        If PatternNomFichier = "" Or _
           Fichier.Name Like PatternNomFichier _
        Then
            If PlusJeuneFichier Is Nothing Then
                Set PlusJeuneFichier = Fichier
            ElseIf Fichier.DateLastModified > PlusJeuneFichier.DateLastModified Then
                Set PlusJeuneFichier = Fichier
            End If
        End If
 
    Next
    ' // Résultat
    If PlusJeuneFichier Is Nothing Then
        NomPlusJeuneFichier = ""
    Else
        NomPlusJeuneFichier = PlusJeuneFichier.Path
    End If
End Function

Cette fonction reste basée sur l'âge des fichiers.

Sinon, puisque le format YYYYMMDD est classable par ordre alphabétique, ton fichier le plus récent, basé sur le nom est :

Function NomPlusJeuneFichierByName(Chemin As String, PatternNomFichier As String) As String
    Dim FSO              As FileSystemObject
    Dim Fichier          As File
    Dim PlusJeuneFichier As File
 
    Set FSO = CreateObject("scripting.filesystemobject")
    For Each Fichier In FSO.GetFolder(Chemin).Files
        If Fichier.Name Like PatternNomFichier _
        Then
            If PlusJeuneFichier Is Nothing Then
                Set PlusJeuneFichier = Fichier
            ElseIf Fichier.Name > PlusJeuneFichier.Name Then
                Set PlusJeuneFichier = Fichier
            End If
        End If
    Next
    ' // Résultat
    If PlusJeuneFichier Is Nothing Then
        NomPlusJeuneFichier = ""
    Else
        NomPlusJeuneFichier = PlusJeuneFichier.Path
    End If
End Function

Sub toto()
    MsgBox NomPlusJeuneFichierByName("########-résultat economique")
End Sub

dans ce code :

Function NomPlusJeuneFichierByName(Chemin As String, PatternNomFichier As String) As String

 
    Dim FSO              As FileSystemObject

    Dim Fichier          As File

    Dim PlusJeuneFichier As File

 
    Set FSO = CreateObject("scripting.filesystemobject")

    For Each Fichier In FSO.GetFolder(Chemin).Files

        If Fichier.Name Like PatternNomFichier _

        Then

            If PlusJeuneFichier Is Nothing Then

                Set PlusJeuneFichier = Fichier

            ElseIf Fichier.Name > PlusJeuneFichier.Name Then

                Set PlusJeuneFichier = Fichier

            End If

        End If

    Next

    ' // Résultat

    If PlusJeuneFichier Is Nothing Then

        NomPlusJeuneFichier = ""

    Else

        NomPlusJeuneFichier = PlusJeuneFichier.Path

    End If

End Function

Sub toto_22()

Dim Chemin As String

 
 Chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Résultat économique"

    MsgBox NomPlusJeuneFichierByName("########-résultat economique")

 
End Sub

je crois bien faire en ajoutant le chemin dans toto()_22

mais il me manque je supose quelque chose pour que ça fonctionne
j'ai remarqué que la fonction : avait deux variables suf que ne vois pas encore ce que je dois renseigner dans

PatternNomFichier

merci bcp de m'en dire un peu plus

Dans NomPlusJeuneFichierByName, il faut donner le chemin, puis le pattern.
Donc :

Chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Résultat économique"

MsgBox NomPlusJeuneFichierByName(Chemin, "########-résultat economique" )

 

bonjour tout le monde j'ai adapté le code comme ci-dessous :

Function NomPlusJeuneFichierByName(Chemin As String, PatternNomFichier As String) As String

 
    Dim Fso              As FileSystemObject

    Dim Fichier          As File

    Dim PlusJeuneFichier As File

 
    Set Fso = CreateObject("scripting.filesystemobject")

    For Each Fichier In Fso.GetFolder(Chemin).Files

        If Fichier.Name Like PatternNomFichier _

        Then

            If PlusJeuneFichier Is Nothing Then

                Set PlusJeuneFichier = Fichier

            ElseIf Fichier.Name > PlusJeuneFichier.Name Then

                Set PlusJeuneFichier = Fichier

            End If

        End If

    Next

    ' // Résultat

    If PlusJeuneFichier Is Nothing Then

        NomPlusJeuneFichierByName = ""

    Else

        NomPlusJeuneFichierByName = PlusJeuneFichier.Path

    End If

End Function

Sub toto_22()

Dim Chemin As String

 
Chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Résultat économique"

MsgBox NomPlusJeuneFichierByName(Chemin, "######## - Résultat Economique")

End Sub

quand je lance "toto_22" j'ai juste le mot "OK" dans ma boite de dialogue et pas le nom du plus jeune fichier qui est l'objet de la recherche.
merci de votre aide .

Gné  

Tu as le mot "Ok" ou le bouton "Ok" ?
Sois précis !

Essaie ce code :

Sub toto_23()

    Dim chemin  As String

    Dim motif   As String

    Dim fichier As String

 
    chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Résultat économique"

    motif = "######## - Résultat Economique"

    fichier = NomPlusJeuneFichierByName(chemin, motif)

 
    If fichier = "" Then

        MsgBox "Le fichier n'a pas été trouvé. " & vbCrLf & vbCrLf & _

               "Vérifier que vous avez CORRECTEMENT orthographié le motif." & vbCrLf & _

               "A savoir qu'un # remplace un chiffre."

    Else

        MsgBox "Le plus jeune des fichiers """ & motif & """ est : " & vbCrLf & fichier

    End If

End Sub

j'ai le bouton "OK" tu as raison  
dans ce code:

Sub toto_22()

Dim chemin As String

Dim motif  As String

motif = "######## - Résultat Economique"

chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Résultat économique"

MsgBox NomPlusJeuneFichierByName(chemin, motif)

 
End Sub

mais dans toto_23 le message est : le fichier n'est pas trouvé j'ai bien verifier pour les chiffres il y en a 8 et j'ai bien respecté les espaces mais le resultat apres execution n'est pas bon

bonjour ,  
là j'essai d'adapter le code selon mes besoins .il s'agit de mettre a la premiere ligne vide
'de la feuil1 du classeur "Classeurvarparahist" ,la derniere ligne non vide de la feuille "Historique
'telle qu'elle a été definie suivant le chemin indiqué
'mais j'ai une erreur au niveau de ma boucle : "lindice n'appartient pas a la selection  
'voici mon code:

Sub toto_22()

Dim i As Long

Dim k As Long

Dim chemin As String, LaFeuille As String, LeFichier As String

Dim motif  As String

Dim wb As Workbook

Dim ws As Worksheet

Set ws = Worksheets("Feuil1")

Set wb = Workbooks("Classeurvarparahist")

k = ws.Cells(Rows.Count, 4).End(xlUp).Row

LaFeuille = "Historik"

motif = "######## - Résultat Economique"

chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Résultat économique"

LeFichier = NomPlusJeuneFichierByName(chemin, motif)

'copie de la derniere ligne du tableau dans l'historique des var

 
    For i = 0 To 27

        wb.ws.Cells(k + 1, i + 1).Value = Workbooks("LeFichier").Worksheets(LaFeuille).Cells(k + 1, i + 1).Value

    Next

    MsgBox NomPlusJeuneFichierByName(chemin, motif)

End Sub

merci d'avance

Set ws = Worksheets("Feuil1" )

Set wb = Workbooks("Classeurvarparahist" )

 
wb.ws...

:/

Set wb = Workbooks("Classeurvarparahist" )

Set ws = wb.Worksheets("Feuil1" )

 
ws...

 

Workbooks("LeFichier" )

ménon !!!

MsgBox "LeFichier"

MsgBox LeFichier

T'as pas compris ?

'je vois j'ai compris, enfin je pense
'voici le code:

Sub toto_22()

Dim i As Long

Dim k As Long

Dim chemin As String, LaFeuille As String, LeFichier As String

Dim motif  As String

Dim wb As Workbook

Dim ws As Worksheet

Set wb = Workbooks("Classeurvarparahist")

Set ws = wb.Worksheets("Feuil1")

 
k = ws.Cells(Rows.Count, 4).End(xlUp).Row + 1

LaFeuille = "Historik"

motif = "######## - Résultat Economique"

chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Résultat économique"

LeFichier = NomPlusJeuneFichierByName(chemin, motif)

'copie de la derniere ligne du tableau dans l'historique des var

    For i = 0 To 27

        ws.Cells(k, i + 1).Value = Workbooks("LeFichier").Worksheets(LaFeuille).Cells(k, i + 1).Value

    Next

 
MsgBox NomPlusJeuneFichierByName(chemin, motif)

End Sub

'merci de me dire ce qui ne va pas dans mon code toto_22...

Réétudie ce code :

LeFichier = "dianbobo"

MsgBox "LeFichier"

MsgBox LeFichier

(ggrgrgrgrgr, il est pourtant ni long, ni compliqué)
Puis relis ta ligne 18.

bonjour tout le monde,bonjour ZEB

dans ton code en essayant de comprendre je vois que
MsgBox "LeFichier" affiche dans la boite de dialogue le Mot "LeFichier"
par contre MsgBox LeFichier m'affiche dianbobo
en regardant ma ligne 18 je ne vois pas l'erreur
j'attend impatiament ton aide ça fait 3 jours que je cherche a resoudre ce probleme

merci d'avance

'bonjour  
'j'ai toujours pas pu resoudre mon probleme .sans ma boucle for le code fonctionne et quand je le lance
'j'ai le bouton "OK"

Sub toto_22()

Dim I As Long

Dim k As Long

Dim Chemin As String, LaFeuille As String, LeFichier As String

Dim motif  As String

Dim wb As Workbook

Dim ws As Worksheet

Dim Tblo

Dim lacellule

Set wb = Workbooks("Classeurvarparahist")

Set ws = wb.Worksheets("Feuil1")

k = ws.Cells(Rows.Count, 4).End(xlUp).Row + 1

LaFeuille = "Historik"

 
motif = "######## - Résultat Economique.xls"

Chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Résultat économique"

LeFichier = NomPlusJeuneFichierByName(Chemin, motif)

  For I = 0 To 27

        ws.Cells(k, I + 1).Value = Workbooks("LeFichier").Worksheets(LaFeuille).Cells(k, I + 1).Value

    Next

    MsgBox NomPlusJeuneFichierByName(Chemin, motif)

End Sub

mais avec ma boucle for j'ai une erreur "l'indice n'appartient pas a la selection"
que dois-je faire pour copier la derniere ligne de ma feuille Historik suivant le chemin
definit ci-dessus et la coller dans mon classeur "Classeurvarparahist" a la premiere ligne vide
de la feuille ("feuil1")

merci d'avance

bonjour ,
ouf comme c'est dur , je veux vraiment savoir ce qu'elle a ma ligne 18?? comme probleme
merci de m'assister
la voici:

For I = 0 To 27

        ws.Cells(k, I + 1).Value = Workbooks("LeFichier" ).Worksheets(LaFeuille).Cells(k, I + 1).Value

    Next

merci d'avance

bonjour ,  
voila j'ai réecrit sub toto_22 plus bas en definisssant un tableau
mais ça ne fonctionne pas aussi

Function NomPlusJeuneFichierByName(Chemin As String, PatternNomFichier As String) As String

 
    Dim Fso              As FileSystemObject

    Dim Fichier          As File

    Dim PlusJeuneFichier As File

 
    Set Fso = CreateObject("scripting.filesystemobject")

    For Each Fichier In Fso.GetFolder(Chemin).Files

        If Fichier.Name Like PatternNomFichier _

        Then

            If PlusJeuneFichier Is Nothing Then

                Set PlusJeuneFichier = Fichier

            ElseIf Fichier.Name > PlusJeuneFichier.Name Then

                Set PlusJeuneFichier = Fichier

            End If

        End If

    Next

    ' // Résultat

    If PlusJeuneFichier Is Nothing Then

        NomPlusJeuneFichierByName = ""

    Else

        NomPlusJeuneFichierByName = PlusJeuneFichier.Path

    End If

End Function

l'erreur se trouve a la ligne 20 de ci -dessous

Sub toto_22()

Dim I As Long

Dim k As Long

Dim Chemin As String, LaFeuille As String, LeFichier As String

Dim motif  As String

Dim wb As Workbook

Dim ws As Worksheet

Dim Tblo(28) As Double

Dim lacellule

Set wb = Workbooks("Classeurvarparahist")

Set ws = wb.Worksheets("Feuil1")

k = ws.Cells(Rows.Count, 4).End(xlUp).Row + 1

LaFeuille = "Historik"

 
motif = "######## - Résultat Economique"

Chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Résultat économique"

LeFichier = NomPlusJeuneFichierByName(Chemin, motif)

For Each lacellule In Tblo

    With Sheets("Feuil1").[G65000].End(xlUp)(2)

        .FormulaArray = "='" & Chemin & "\[" & LeFichier & "]" & LaFeuille & "'!" & lacellule

        .Value = .Value

    End With

Next lacellule

    MsgBox NomPlusJeuneFichierByName(Chemin, motif)

End Sub

si quelqu'un veit bien m'aider
merci

Bonjour,
j'essai de corriger l'erreur qui me bloc
 
etant donné k la derniere ligne de la feuille ("Feuil1") ,je voudrais copier la derniere ligne
de la feuille "historik" sachant que cette ligne change chaque jour elle est toujours a "k+1"
comment bien definir le tableau:

Range("A(k) :AB(k)")

'merci de votre aide
jai essayé comme ça :

Workbooks("LeFichier").Worksheets(LaFeuille).Range("Ak :ABk").Copy Worksheets("Feuil1").Range("A" & k)

mais ça marche pas
nb:

Set ws = wb.Worksheets("Feuil1") 

k = ws.Cells(Rows.Count, 4).End(xlUp).Row + 1 

LaFeuille = "Historik"

merci de votre aide
 

bonjour
voila ci-dessous mon code :

Function NomPlusJeuneFichierByName(Chemin As String, PatternNomFichier As String) As String

 
    Dim Fso              As Object

    Dim Fichier          As Object

    Dim PlusJeuneFichier As String

 
    Set Fso = CreateObject("scripting.filesystemobject")

    For Each Fichier In Fso.GetFolder(Chemin).Files

        If Fichier.Name Like PatternNomFichier Then

            PlusJeuneFichier = Fichier.Name

        End If

    Next

    ' // Résultat

    If PlusJeuneFichier = "" Then

        NomPlusJeuneFichierByName = ""

    Else

        NomPlusJeuneFichierByName = PlusJeuneFichier

    End If

End Function

Sub recherche_resultat_eco()

Dim i As Long

Dim k As Long

Dim Chemin As String, LaFeuille As String, LeFichier As String

Dim motif  As String

Dim wb As Workbook

Dim ws As Worksheet

Set wb = Workbooks("Classeurvarparahist")

Set ws = wb.Worksheets("Feuil1")

    LaFeuille = "Historik"

    k = ws.Cells(Rows.Count, 4).End(xlUp).Row + 1

    motif = "######## - Résultat Economique*"

    Chemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Résultat économique\"

    LeFichier = NomPlusJeuneFichierByName(Chemin, motif)

    Workbooks(LeFichier).Worksheets(LaFeuille).Range("A" & k & ":AB" & k).Copy ws.Range("A" & k)

    MsgBox NomPlusJeuneFichierByName(Chemin, motif)

End Sub

en faisant F8 j'ai bien tout marche sauf cette ligne :

Workbooks(LeFichier).Worksheets(LaFeuille).Range("A" & k & ":AB" & k).Copy ws.Range("A" & k)

erreur l'indice n'appartient pas a la selection

si quelqu'un veut bien m'aider
merci

voila le probleme est resolu enfin
 
il fallait faire :

Workbooks.Open Filename:=Chemin & LeFichier

 
    For i = 1 To 28

        ws.Cells(k, i).Formula = Workbooks(LeFichier).Worksheets(LaFeuille).Cells(k, i).Value

    Next

   ActiveWindow.Close

merci encore

Meilleure réponse sélectionnée par dianbobo.