Copier d'un classuer vers un autre

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("classeurvarpa&hist.xls").Activate
    Range("B1").Select
    ActiveSheet.Paste
    Windows("classeurvarpa&hist.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

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

bonsoir,

si tes fichiers commencent tous ainsi : "2010-06-30.....", essaie ce 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

    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()
    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

Bon courage

Grand merci cousinhub !!

le code modifié comme tu l'a fait est parfait il fonctionne bien et me recupère bien le fichier le plus recent dans ma boite de dialogue

mais une chose reste a faire et je ne vois pas comment m'y prendre :

en fait le fichier le plus recent est un classeur excel ,je voudrai aller a la feuille (feuil1) de ce classeur et copier la valeur de la cellule D32 et H32(en fait se serra toujours le cas copier H32 et D32 DU fichier le plus recent)

PUIS les coller respectivement dans feuil2 de mon classeur nommé"varpam" en collone G et I a la derniere cellule vide

MERCI ENCORE

-- 01 Juil 2010, 16:05 --

voila j'ai bricolé ce code mais j'ai une erreur " l'indice n'appartient pas a la selection "

voici le code :

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

l'erreur se trouve a ce niveau:

Workbooks("Classeurvarpara&hist").Worksheets("Feuil2").Cells(k + 1, "G").Value = _
    Workbooks("NomPlusJeuneFichier").Worksheets("Synthèse").Cells(32, "D").Value

d'abord est ce correct de l'ecrire comme ça?

merci d'avance

Bonjour,

En gardant ta fonction "NomPlusJeuneFichier", rajoute ce code :

Sub toto()
Dim LeChemin As String, LaFeuille As String, LeFichier As String
Dim LaCellule
Dim Tblo
Tblo = Array("D32", "H32")
LeChemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Synthèse"
LeFichier = NomPlusJeuneFichier(LeChemin)
LaFeuille = "Feuil1"
For Each LaCellule In Tblo
    With Sheets("Feuil2").[G65000].End(xlUp)(2)
        .FormulaArray = "='" & LeChemin & "\[" & LeFichier & "]" & LaFeuille & "'!" & LaCellule
        .Value = .Value
    End With
Next LaCellule
End Sub

Bon Week-End

-- Ven Juil 02, 2010 3:37 pm --

Edit...

Une petite erreur, que j'avais rectifiée dans mes essais, mais que j'ai oublié de t'en faire part dans ma réponse....

Dans la Function :

Function NomPlusJeuneFichier(Chemin As String) As String

Il faut que tu modifies une ligne :

NomPlusJeuneFichier = plus_Jeune_fichier.Path

par :

NomPlusJeuneFichier = plus_Jeune_fichier.Name

Scuse....

bonjour cousinhub , bonjour tout le monde

j'ai essayé le code et fait les modifications comme tu me l'a demandé , il y a un dernier problème

lle tableau Array me met les valeurs en colonne G au deux premieres cellules vides , mais je veux plutot que la valeur de D32 soit a la premiere cellule vide de la colonne G (c'est fait) mais c'est la valeur de H32 qui doit aller a la collone I et sur la meme ligne que D32.

merci

Bonjour,

essaie ainsi :

Sub toto()
Dim LaCellule
Dim Tblo
Dim I As Byte
Tblo = Array("D32", "H32")
LeChemin = "S:\PGB\DER\_Commun\MBO\RESULTAT ECO  suivi quotidien\Synthèse"
LeFichier = NomPlusJeuneFichier(LeChemin)
LaFeuille = "Feuil1"
For Each LaCellule In Tblo
    With Sheets("Feuil2").[G65000].End(xlUp)(2)
        .Offset(0, I).FormulaArray = "='" & LeChemin & "\[" & LeFichier & "]" & LaFeuille & "'!" & LaCellule
        .Offset(0, I).Value = .Offset(0, I).Value
    End With
    I = 2
Next LaCellule
End Sub

Bonne journée

vous avez surement une meilleur façon de le fair mais moi j'ai bricolé ça comme ci-dessous et ça fonctionne:

Sub toto_1()
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 cousinhub

Re-,

As-tu regardé le dernier code que je viens de t'envoyer?

oui je viens de regarder ce que tu m'as envoyé sauf que H32 ne se met pas sur la meme ligne que D32, H32 est bien en collone I

SI PAR EXEMPPLE d32 est en G50 , H32 SE MET EN i51

Re-,

effectivement...

autre essai :

LaLigne = Sheets("Feuil2").[G65000].End(xlUp)(2).Row
For Each LaCellule In Tblo
    With Sheets("Feuil2").Cells(LaLigne, 7)
        .Offset(0 , I).FormulaArray = "='" & LeChemin & "\[" & LeFichier & "]" & LaFeuille & "'!" & LaCellule
        .Offset(0 , I).Value = .Offset(0, I).Value
    End With
    I = 2
Next LaCellule