Discussion :

[marccelestins]

Bonjour,

J'ai un dossier contenant x fichiers. Dans chacun de ses fichiers, j'ai une seule feuille.J'aimerais récupérer le fichier le plus récent, copier la feuille et le coller dans mon fichier de destination dans l'onglet "H".

Moi j'avais écris ce code mais je suis obligé de choisir mon fichier et copie colle.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Copie_coller()
 
Dim Fichier, Repdefaut As String
 
RepPardefaut = "C:\Test " ' Répertoire
ChDrive "C:" ' Choix du lecteur à adapter
ChDir "C:\Test " 'Choix du répertoire à adapter
 
Fichier = Application.GetOpenFilename("Fichiers Excel (*.xls), *.xlsx", , "Sélectionner un fichier.")
If Fichier <> False Then
    Application.ScreenUpdating = False
    Workbooks.Open Fichier
    Sheets("feuil1").Cells.Copy ThisWorkbook.Sheets("H").Range("A1") ' Nom des feuilles à adapter
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
End If
' remise en place du répertoire par défaut
ChDrive "C:"
CurDir RepPardefaut

[joe.levrai]

Bonjour,

qu'appelles-tu le plus récent ? Le plus récemment crée ou le plus récemment modifié ?


voici une fonction qui retourne le nom du fichier le plus récent, à toi de choisir la bonne définition de "récent"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Function LePlusRecent(LeChemin As String) As String
Dim NomFichier As String, DateFichier As Date
Dim Fso: Set Fso = CreateObject("Scripting.FileSystemObject")
Dim Dossier As Object: Set Dossier = Fso.GetFolder(LeChemin)
Dim LesFichiers: Set LesFichiers = Dossier.Files
Dim UnFichier
 
' pour le fichier le plus récemment MODIFIE : utiliser DateLastModified au lieu de DateCreated
    For Each UnFichier In LesFichiers
        If UnFichier.DateCreated > DateFichier Then
            DateFichier = UnFichier.DateCreated
            NomFichier = UnFichier.Name
        End If
    Next
    Set Fso = Nothing
    LePlusRecent = NomFichier
End Function
 
Sub toto()
Dim Chemin As String: Chemin = "C:\"
MsgBox "Le Fichier le plus récent du dossier """ & Chemin & """ est : " & LePlusRecent(Chemin)
End Sub

[marccelestins]

Ok Merci à toi. SI je souhaite copier une feuille de ce fichier et le coller dans mon fichier de destination dans l'onglet "H"?

[joe.levrai]

Bonjour,

la fonction retourne le nom du fichier.
lors de son appel, on indique dans la procédure principale le chemin menant au fichier

donc il te suffit d'utiliser cette fonction pour remplacer la sélection de dossier que tu fais actuellement :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub Copie_coller()
Dim Wb As Workbook
Dim Repdefaut As String: Repdefaut = "C:\Test"
Application.ScreenUpdating = False
    Set Wb = Workbooks.Open(Repdefaut & LePlusRecent(Repdefaut))
    Exit Sub
    With Wb
        .Sheets("feuil1").Cells.Copy ThisWorkbook.Sheets("H").Range("A1")
        .Close False
    End With
Application.ScreenUpdating = True
End Sub
 
Function LePlusRecent(LeChemin As String) As String
Dim NomFichier As String, DateFichier As Date
Dim Fso: Set Fso = CreateObject("Scripting.FileSystemObject")
Dim Dossier As Object: Set Dossier = Fso.GetFolder(LeChemin)
Dim LesFichiers: Set LesFichiers = Dossier.Files
Dim UnFichier
 
' pour le fichier le plus récemment MODIFIE : utiliser DateLastModified au lieu de DateCreated
    For Each UnFichier In LesFichiers
        If UnFichier.DateCreated > DateFichier Then
            DateFichier = UnFichier.DateCreated
            NomFichier = UnFichier.Name
        End If
    Next
    Set Fso = Nothing
    LePlusRecent = NomFichier
End Function

[marccelestins]

Il ouvre le fichier mais il ne copie ni l'onglet feuil1 ni le colle dans mon fichier de destination. Est il possible de copier et coller sans que le fichier ne s'ouvre ?

[joe.levrai]

Arf !

enlève la ligne 6 de mon code ... j'ai oublié de l'enlever après mon test

cette ligne stop la macro ... juste après avoir ouvert le fichier.

tiens, j'ai supprimé une variable qui ne servait pas à grand chose au passage :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub Copie_coller()
Dim Repdefaut As String: Repdefaut = "C:\Test\"
Application.ScreenUpdating = False
    With Workbooks.Open(Repdefaut & LePlusRecent(Repdefaut))
        .Sheets("feuil1").Cells.Copy ThisWorkbook.Sheets("H").Range("A1")
        .Close False
    End With
Application.ScreenUpdating = True
End Sub

[marccelestins]

Merci à toi !! ça marche super bien. dans ma feuil1 les colonnes exploitées sont de A à F. J'aimerais coller la feuil1 et les coller dans ma feuille de destination "H". car j'ai des formules en colonne E que je ne veux pas effacer. car en ce moment j'ai l'impression qu'elle copie et elle efface tout ce qui est dans ma feuille"H"

Est ce possible de copier la feuil1 si elle se nomme différemment selon les fichiers sachant que dans chaque classeur il n'y a qu'un seul onglet ?

[joe.levrai]

S'il n'y a qu'une feuille dans ton classeur, au lieu de faire référence à son nom Worksheets("Feuil1"), tu peux faire référence à son index : Worksheets(1)


je n'ai pas compris ta première question en revanche, c'est normal que la colonne E soit écrasée puisque tu copies toute une feuille qui s'étend sur plusieurs colonnes ... colonne E comprise

[marccelestins]

Ok merci très gentil à toi pour ta réaction. Ok je comprends mieux maintenant grâce à toi.

[papamarc]

Bonjour a tous,

je poste ici car c'est ce que j'ai trouvé de plus ressemblant a mon besoin.

j'aimerai une macro qui me copie/colle tous les fichiers qui sont plus récents qu'une date dans une cellule d'un dossier vers un autre
je pense qu'il faut faire une boucle et ca je ne maitrise pas

quelqu'un peut-il m'aider ?

Merci d'avance