Copier données d'un classeur vers un autre [Résolu]

Signaler
Messages postés
151
Date d'inscription
mardi 20 avril 2010
Statut
Membre
Dernière intervention
15 juin 2014
-
Messages postés
151
Date d'inscription
mardi 20 avril 2010
Statut
Membre
Dernière intervention
15 juin 2014
-
bonjour
j'ai envi de faire un code
avec l'enregisteur de macro j'ai obtenu ceci:

Sub Macro9()
'
' Macro9 Macro
'
' Touche de raccourci du clavier: Ctrl+y
'
    Workbooks.Open Filename:= _
        "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Synthèse\2010-6-21 Résultat économique.xls"
    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Sheets("Synthèse").Select
    ActiveWindow.SmallScroll Down:=3
    Range("D32").Select
    Selection.Copy
    Windows("classeurvarpa&hist.xls").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Windows("classeurvarpa&hist.xls").Activate
    Range("H32").Select
    Application.CutCopyMode = False
    Selection.Copy
    Application.WindowState = xlMinimized
    Windows("20100510 - Stress Ptf Financier.xls").Activate
    Range("B1").Select
    ActiveSheet.Paste
    Windows("2010-6-21 Résultat économique.xls").Activate
    ActiveWindow.Close
End Sub
 



je vous explique ce qu'il a a faire :
le classeur dans lequel je travail s'appelle: "classeurvarpa&hist"
je voudrai allez dans un classeur dont la date de modification est plus proche de la date d'aujourd'hui ou bien qu'elle soit egale a la date d'aujourd'hui.en fait les classeurs sont ranger dans l'ordre croissant suivant les dates de modifications ,je veux donc aller dans celui qui a la date maximale
par le chemin:
"S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Synthèse\2010-6-21 Résultat économique.xls"


1)il se trouve que ce classeur est fermé(je veux bien faire une copie avec le classeur fermé).
une fois dans ce classeur je veux copier les cellules
H32
et
 D32

PUIS les coller respectivement dans mon classeur"classeurvarpa&hist" a la feuille 2 en a la derniere ligne vide respectivement a la colonne G et I

merci de votre aide

13 réponses

Messages postés
151
Date d'inscription
mardi 20 avril 2010
Statut
Membre
Dernière intervention
15 juin 2014

bonjour,voici la 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\2010 - 07"
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
 
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
74
Salut
Première remarque : le format date que tu as choisi aurait gagné à avoir un numéro de mois sur 2 digits, 06 à la place de 6
Idem pour les jours.
De cette manière, le texte représentant cette date aura toujours le même format :
- Dans le gestionnaire de fichier de Windows, les fichiers apparaitront plus proprement
- Dans ton programme, tu te simplifieras la vie

Pour ce qui est du programme :
Tu veux récupérer le dernier fichier d'un répertoire.
Pour faire simple, on va considérer que, sur ce répertoire, :
- il n'y a QUE les fichiers que tu veux appeler
- ET que leur nom permet un classement chronologique efficace

Exemple de recherche du dernier fichier d'un répertoire :
    Dim sRépertoire As String
    Dim sFichier As String
    Dim sTemp As String
    
    sRépertoire = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Synthèse"
    sTemp = Dir(sRépertoire & "*.xls")
    Do While sTemp <> ""
        sFichier = sTemp
        sTemp = Dir
    Loop
    MsgBox "Le dernier fichier : " & sFichier

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
Messages postés
151
Date d'inscription
mardi 20 avril 2010
Statut
Membre
Dernière intervention
15 juin 2014

voila j'ai essayé le code il fonctionne mais il n me recupère pas le dernier fichier du dossier
en realité il existe un dossier dans le dossier synthese nommé "2010-04" qui se trouve tout en haut ..
merci encore de votre aide
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
74
Chez moi, cela marche parfaitement.

"mais il n me recupère pas le dernier fichier du dossier"
Si tu ne nous dis pas ce qu'il devrait voir et ce qu'il trouve, on ne pourra pas te dire d'où vient l'erreur.

Je suppose que tu as modifié le programme pour spécifier/filtrer tes fichiers : quelle syntaxe as-tu utilisé ?

"il existe un dossier dans le dossier synthese nommé "2010-04" qui se trouve tout en haut .."
Oui, et quel est le rapport ?
tout en haut de quoi ? de l'explorateur de fichiers Windows ? Oui, bah c'est normal quand on classe la liste par ordre alphabétique, les sous-répertoires sont toujours en tête de liste, mais le programme que je t'ai fourni n'en tient pas compte - pourquoi est-ce un problème chez toi ?

Avant de cliquer sur le bouton "Envoyer le message", relis toi et imagine toi qu'on ne connait pas ton environnement ni ce que tu as sous les yeux. Explique bien tout.
Messages postés
151
Date d'inscription
mardi 20 avril 2010
Statut
Membre
Dernière intervention
15 juin 2014

voila , dans le dossier synthèse apres execution de la macro la boite de dialogue m'affiche que le dernier fichier est :
2010-6-9 résultat économique.xls


alors que je veux que se soit celui du 2010-6-22
(format de date: année-mois-jour)
voici le code que j'ai dans ma macro:
Sub copi_cpr_mli()
Dim sRépertoire As String
Dim sFichier As String
Dim sTemp As String
 
    sRépertoire = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Synthèse"
    sTemp = Dir(sRépertoire & "*.xls")
    Do While sTemp <> ""
        sFichier = sTemp
        sTemp = Dir
    Loop
    MsgBox "Le dernier fichier : " & sFichier

    
    
End Sub

quand je dit qu'il existe un dossier tout en haut cela signifie que ce dossier se situe avant tous les classeurs

je ne veux pas tout simplement afficher le dernier classeur mais plutot copier le contenu des cellules D32 et H32 puis mettre ces valeurs dans mon classeur ("classeurvarpam&hist")
merci j'espere avoir été un peu plus claire
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
74
Ok, tu as gardé le code tel quel.
Il te désigne le fichier 2010-6-9 comme dernier fichier alors qu'il en existe un autre, sur le même répertoire, qui porte la date du 2010-6-22.
Est-ce bien cela ?
Je ne vois toujours pas pourquoi tu me parles du dossier. Pourquoi voudrais-tu qu'il interfère avec la liste des fichiers ?

Ouvre ton explorateur de fichiers Windows (Touche Windows + E)
Va dans le répertoire 'Synthèse'.
Assure toi que les fichiers sont triés par ordre croissant alphabétique et regarde quel est le nom du dernier fichier XLS.

Si ce n'est pas 2010-6-9, lequel ?
Ecris ici le nom exact des 3 ou 4 derniers fichiers listés.

Ah, ou alors tu veux que la recherche se fasse aussi dans le sous-répertoire dont tu parles ?

Dans ce cas, ça va être plus coton car la commande Dir ne peut fonctionner sur plusieurs répertoires en même temps. Il faudra donc :
- rechercher le dernier fichier du répertoire 'Synthèse',
- puis chercher le dernier répertoire du sous-répertoire (même fonction, avec répertoire différent)
- puis comparer les deux noms de fichiers ainsi trouvés pour savoir lequel représente le nom de la date la plus récente.

Après, une fois que tu auras ce nom de fichier, tes histoires de copie de cellule peuvent se résoudre avec le code que tu nous a montré ET en utilisant les variables stockant le chemin et le nom du fichier choisi en lieu et place de celui écrit en dur, "2010-6-21 Résultat économique.xls" (2 endroits)
Mais une chose à la fois, fais le test énoncé ci-dessus et dis nous si le sous-répertoire a un rôle actif dans cette recherche.
Messages postés
151
Date d'inscription
mardi 20 avril 2010
Statut
Membre
Dernière intervention
15 juin 2014

bonjour ,
dans mon dossier synthèse il me designe le fichier 2010-6-9 comme dernier fichier alors qu'il en existe d'autre jusqu'a la date 2010-6-22
cela signifie qu'apres 2010-6-9 on a 2010-6-10,
2010-6-11,2010-6-12,...jusqu'a 2010-6-22.
oublions le dossier dont j'ai parlé c'etait juste pour que tu sache qu'il existe dans le dossier synthèse(les données quil contient ne m'interressent pas)
-les fichiers sont triés par ordre croissant suivant leur noms et leurs dates de modification
exemple:
nom date modification
2010-6-9 résultat économique 10/06/2010 09:14
2010-6-10 résultat économique 11/06/2010 09:09
.
.
2010-6-21 résultat économique 22/06/2010 09:40
2010-6-22 résultat économique 23/06/2010 09:43
voici ci dessous les noms des 4 dernier fichiers
listés
2010-6-17 résultat économique
2010-6-18 résultat économique
2010-6-21 résultat économique
2010-6-22 résultat économique
ils sont tous du type :feuille microsoft office exel 97-2003.

a ta derniere question:non je ne veux pas que la recherche se passe aussi dans le sous repertoire .! le sous repertoire n'a aucun role actif dans cette recherche.

merci d'avance votre aide m'est précieuse
Messages postés
151
Date d'inscription
mardi 20 avril 2010
Statut
Membre
Dernière intervention
15 juin 2014

je réecrit cette partit ci dessous
-les fichiers sont triés par ordre croissant suivant leur noms et leurs dates de modification
exemple:
nom..........................date modification
2010-6-9 résultat économique 10/06/2010 09:14
2010-6-10 résultat économique 11/06/2010 09:09
.
.
2010-6-21 résultat économique 22/06/2010 09:40
2010-6-22 résultat économique 23/06/2010 09:43
voici ci dessous les noms des 4 dernier fichiers
listés
2010-6-17 résultat économique
2010-6-18 résultat économique
2010-6-21 résultat économique
2010-6-22 résultat économique
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
74
La commande Dir ne fonctionne que sur le tri de fichiers par ordre alphabétique, rien d'autre.
Donc, si tu veux voir la liste telle que la fonction Dir la verra, il ne faut trier les fichiers dans le gestionnaire de fichiers que par leur Nom.

Après tout, aucune doc ne dit que Dir verra les fichiers dans l'ordre alphabétique, bien que cela me semble bizarre qu'il y ait un autre ordre.
Tu peux peut-être ajouter cette ligne dans la boucle pour voir l'ordre de scrutation :
    Do While sTemp <> ""
        sFichier = sTemp
        Debug.Print sFichier  ' ligne à ajouter
        sTemp = Dir
    Loop
et le résultat apparaitra dans la fenêtre de debug (Ctrl-G)

Si vraiment Dir n'en fait qu'à sa tête, il va falloir faire le tri toi même :
Même méthode avec le Dir et sa boucle, mais chaque nom de fichier sera stocké dans un tableau de String :
    Dim monTableau() As String   ' à ajouter
    Dim x As Integer
    x = -1
    Do While sTemp <> ""
        x = x + 1
        ReDim Preserve monTableau(0 To x)
        monTableau(x) = sTemp
        sTemp = Dir
    Loop

Une fois ce tableau rempli, il faudra le trier.
Recherche parmi les codes VB6 ceux qui parlent de "tri".
Les fichiers FRM et BAS des projets VB6 peuvent être visualisés sous NotePad ou WordPad

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
74
PS repetita : Attention au format des chiffres dans une chaine :
Pour comparer sans ambigüité une chaine de ce genre, il vaut mieux mettre les n° de jour et de mois sur 2 digits
2010-6-2 --> 2010-06-02
car la comparaison de chaine se fait caractère par caractère :
2010-6-9
2010-6-22
Il y a un risque que 2010-6-9 soit déclaré plus vieux que 2010-6-22 car les chaines sont identiques au départ : "2010-6-" mais ensuite, quand on compare "9" avec "2", c'est le 2 qui gagne puisqu'il est bien avant le 9 dans les codes ASCII.
Messages postés
151
Date d'inscription
mardi 20 avril 2010
Statut
Membre
Dernière intervention
15 juin 2014

bonjour tout le monde
je suis perdu je n'arrive pas a avancer .....
Messages postés
151
Date d'inscription
mardi 20 avril 2010
Statut
Membre
Dernière intervention
15 juin 2014

bonjour tout le monde ,
j'ai progressé dans ma recherche mais le resultat n'est pas celui que je veux

en fait dans un premier temps je veux trouver le classeur le plus recent du dossier synthèse
mais ma boite de dialogue me dit que c'est celui du 25/06/2010 alors que c'est celui d'hier (30/06/2010)le plus recent

comment je peux y remedier??

voici mon code:


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 récent du répertoire S:\ est : " & NomPlusJeuneFichier(Chemin)

End Sub


merci de votre aide
Messages postés
151
Date d'inscription
mardi 20 avril 2010
Statut
Membre
Dernière intervention
15 juin 2014

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 ''

merci de me venir en aide.