1 - pour importer le dernier (par date de création) fichier Excel dont le
nom est ABC_jjmm.aa.xls.
jjmmaa correspond à la date du jour de création du fichier et également la
date à laquelle l'importation se fait.
Pour information, ce fichier (ABC_jjmmaa.xls) ne comporte qu'un seul onglet.
Il faudrait que cet onglet vienne s'ajouter en dernier (à droite) des
onglets du fichier ouvert.
2 - pour supprimer toutes les lignes de cette feuille dont la valeur (nom)
de la colonne A ne figure pas dans une liste pré-définie.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
FFO
Salut à toi
Soit Mon document le classeur avec en Feuil1 colonne A à partir de la ligne 2 la liste des noms
Je te propose ce code :
With Application.FileSearch .LookIn = "C:Chemin" .FileType = msoFileTypeExcelWorkbooks .Execute End With With Application.FileSearch Donnée = 0 For I = 1 To .FoundFiles.Count If Mid(.FoundFiles(I), Len(.LookIn) + 2) Like "ABC*" Then If CDate(Mid(.FoundFiles(I), Len(.LookIn) + 6, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 8, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 10, 2)) > CDate(Donnée) Then Donnée = CDate(Mid(.FoundFiles(I), Len(.LookIn) + 6, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 8, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 10, 2)) Fichier = Mid(.FoundFiles(I), Len(.LookIn) + 2) End If End If Next I .Application.Workbooks.Open Filename:="C:Chemin" & Fichier End With ActiveSheet.Copy Workbooks("Mon document").ActiveSheet ActiveSheet.Move after:=Sheets(Sheets.Count) Workbooks(Fichier).Close J = ActiveSheet.Range("A65535").End(xlUp).Row Do While J > 1 Ligne = 0 On Error Resume Next Ligne = Sheets("Feuil1").Range("A1", "A" & Sheets("Feuil1").Range("A65535").End(xlUp).Row).Find(What:¬tiveSheet.Range("A" & J), after:=Sheets("Feuil1").Range("A1"), LookIn:=xlValues, _ LookAt:=xlWhole).Row If Ligne = 0 Then ActiveSheet.Rows("" & J & ":" & J & "").Delete End If J = J - 1 Loop
Actualises les parties :
C:Chemin de l'adresse du répertoire Mon document du nom de ton classeur Feuil1 du nom de la feuille portant la liste
Attention ces groupes de lignes sont à mettre bout à bout en 1 seule ligne :
Soit Mon document le classeur avec en Feuil1 colonne A à partir de la ligne
2 la liste des noms
Je te propose ce code :
With Application.FileSearch
.LookIn = "C:Chemin"
.FileType = msoFileTypeExcelWorkbooks
.Execute
End With
With Application.FileSearch
Donnée = 0
For I = 1 To .FoundFiles.Count
If Mid(.FoundFiles(I), Len(.LookIn) + 2) Like "ABC*" Then
If CDate(Mid(.FoundFiles(I), Len(.LookIn) + 6, 2) & "/" &
Mid(.FoundFiles(I), Len(.LookIn) + 8, 2) & "/" & Mid(.FoundFiles(I),
Len(.LookIn) + 10, 2)) > CDate(Donnée) Then
Donnée = CDate(Mid(.FoundFiles(I), Len(.LookIn) + 6, 2) & "/" &
Mid(.FoundFiles(I), Len(.LookIn) + 8, 2) & "/" & Mid(.FoundFiles(I),
Len(.LookIn) + 10, 2))
Fichier = Mid(.FoundFiles(I), Len(.LookIn) + 2)
End If
End If
Next I
.Application.Workbooks.Open Filename:="C:Chemin" & Fichier
End With
ActiveSheet.Copy Workbooks("Mon document").ActiveSheet
ActiveSheet.Move after:=Sheets(Sheets.Count)
Workbooks(Fichier).Close
J = ActiveSheet.Range("A65535").End(xlUp).Row
Do While J > 1
Ligne = 0
On Error Resume Next
Ligne = Sheets("Feuil1").Range("A1", "A" &
Sheets("Feuil1").Range("A65535").End(xlUp).Row).Find(What:¬tiveSheet.Range("A" & J), after:=Sheets("Feuil1").Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole).Row
If Ligne = 0 Then
ActiveSheet.Rows("" & J & ":" & J & "").Delete
End If
J = J - 1
Loop
Actualises les parties :
C:Chemin de l'adresse du répertoire
Mon document du nom de ton classeur
Feuil1 du nom de la feuille portant la liste
Attention ces groupes de lignes sont à mettre bout à bout en 1 seule ligne :
Soit Mon document le classeur avec en Feuil1 colonne A à partir de la ligne 2 la liste des noms
Je te propose ce code :
With Application.FileSearch .LookIn = "C:Chemin" .FileType = msoFileTypeExcelWorkbooks .Execute End With With Application.FileSearch Donnée = 0 For I = 1 To .FoundFiles.Count If Mid(.FoundFiles(I), Len(.LookIn) + 2) Like "ABC*" Then If CDate(Mid(.FoundFiles(I), Len(.LookIn) + 6, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 8, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 10, 2)) > CDate(Donnée) Then Donnée = CDate(Mid(.FoundFiles(I), Len(.LookIn) + 6, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 8, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 10, 2)) Fichier = Mid(.FoundFiles(I), Len(.LookIn) + 2) End If End If Next I .Application.Workbooks.Open Filename:="C:Chemin" & Fichier End With ActiveSheet.Copy Workbooks("Mon document").ActiveSheet ActiveSheet.Move after:=Sheets(Sheets.Count) Workbooks(Fichier).Close J = ActiveSheet.Range("A65535").End(xlUp).Row Do While J > 1 Ligne = 0 On Error Resume Next Ligne = Sheets("Feuil1").Range("A1", "A" & Sheets("Feuil1").Range("A65535").End(xlUp).Row).Find(What:¬tiveSheet.Range("A" & J), after:=Sheets("Feuil1").Range("A1"), LookIn:=xlValues, _ LookAt:=xlWhole).Row If Ligne = 0 Then ActiveSheet.Rows("" & J & ":" & J & "").Delete End If J = J - 1 Loop
Actualises les parties :
C:Chemin de l'adresse du répertoire Mon document du nom de ton classeur Feuil1 du nom de la feuille portant la liste
Attention ces groupes de lignes sont à mettre bout à bout en 1 seule ligne :
Merci mais malheureusement cela ne semble pas fonctionner même avec les modifications à apporter. Pour info, le fichier à importer se trouve dans "G:Posit_Devises_ddmmmyy" et le fichier ouvert a comme nom "Métaux 2.xls". Déjà je ne suis pas certain d'avoir copié le code au bon endroit (Module ?). Je n'arrive pas à importer le fichier ; ce qui est le plus important car je pourrais me passer de l'effacement des lignes.
Encore merci
"FFO" a écrit :
Salut à toi
Soit Mon document le classeur avec en Feuil1 colonne A à partir de la ligne 2 la liste des noms
Je te propose ce code :
With Application.FileSearch .LookIn = "C:Chemin" .FileType = msoFileTypeExcelWorkbooks .Execute End With With Application.FileSearch Donnée = 0 For I = 1 To .FoundFiles.Count If Mid(.FoundFiles(I), Len(.LookIn) + 2) Like "ABC*" Then If CDate(Mid(.FoundFiles(I), Len(.LookIn) + 6, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 8, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 10, 2)) > CDate(Donnée) Then Donnée = CDate(Mid(.FoundFiles(I), Len(.LookIn) + 6, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 8, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 10, 2)) Fichier = Mid(.FoundFiles(I), Len(.LookIn) + 2) End If End If Next I .Application.Workbooks.Open Filename:="C:Chemin" & Fichier End With ActiveSheet.Copy Workbooks("Mon document").ActiveSheet ActiveSheet.Move after:=Sheets(Sheets.Count) Workbooks(Fichier).Close J = ActiveSheet.Range("A65535").End(xlUp).Row Do While J > 1 Ligne = 0 On Error Resume Next Ligne = Sheets("Feuil1").Range("A1", "A" & Sheets("Feuil1").Range("A65535").End(xlUp).Row).Find(What:¬tiveSheet.Range("A" & J), after:=Sheets("Feuil1").Range("A1"), LookIn:=xlValues, _ LookAt:=xlWhole).Row If Ligne = 0 Then ActiveSheet.Rows("" & J & ":" & J & "").Delete End If J = J - 1 Loop
Actualises les parties :
C:Chemin de l'adresse du répertoire Mon document du nom de ton classeur Feuil1 du nom de la feuille portant la liste
Attention ces groupes de lignes sont à mettre bout à bout en 1 seule ligne :
Merci mais malheureusement cela ne semble pas fonctionner même avec les
modifications à apporter.
Pour info, le fichier à importer se trouve dans "G:Posit_Devises_ddmmmyy"
et le fichier ouvert a comme nom "Métaux 2.xls".
Déjà je ne suis pas certain d'avoir copié le code au bon endroit (Module ?).
Je n'arrive pas à importer le fichier ; ce qui est le plus important car je
pourrais me passer de l'effacement des lignes.
Encore merci
"FFO" a écrit :
Salut à toi
Soit Mon document le classeur avec en Feuil1 colonne A à partir de la ligne
2 la liste des noms
Je te propose ce code :
With Application.FileSearch
.LookIn = "C:Chemin"
.FileType = msoFileTypeExcelWorkbooks
.Execute
End With
With Application.FileSearch
Donnée = 0
For I = 1 To .FoundFiles.Count
If Mid(.FoundFiles(I), Len(.LookIn) + 2) Like "ABC*" Then
If CDate(Mid(.FoundFiles(I), Len(.LookIn) + 6, 2) & "/" &
Mid(.FoundFiles(I), Len(.LookIn) + 8, 2) & "/" & Mid(.FoundFiles(I),
Len(.LookIn) + 10, 2)) > CDate(Donnée) Then
Donnée = CDate(Mid(.FoundFiles(I), Len(.LookIn) + 6, 2) & "/" &
Mid(.FoundFiles(I), Len(.LookIn) + 8, 2) & "/" & Mid(.FoundFiles(I),
Len(.LookIn) + 10, 2))
Fichier = Mid(.FoundFiles(I), Len(.LookIn) + 2)
End If
End If
Next I
.Application.Workbooks.Open Filename:="C:Chemin" & Fichier
End With
ActiveSheet.Copy Workbooks("Mon document").ActiveSheet
ActiveSheet.Move after:=Sheets(Sheets.Count)
Workbooks(Fichier).Close
J = ActiveSheet.Range("A65535").End(xlUp).Row
Do While J > 1
Ligne = 0
On Error Resume Next
Ligne = Sheets("Feuil1").Range("A1", "A" &
Sheets("Feuil1").Range("A65535").End(xlUp).Row).Find(What:¬tiveSheet.Range("A" & J), after:=Sheets("Feuil1").Range("A1"), LookIn:=xlValues, _
LookAt:=xlWhole).Row
If Ligne = 0 Then
ActiveSheet.Rows("" & J & ":" & J & "").Delete
End If
J = J - 1
Loop
Actualises les parties :
C:Chemin de l'adresse du répertoire
Mon document du nom de ton classeur
Feuil1 du nom de la feuille portant la liste
Attention ces groupes de lignes sont à mettre bout à bout en 1 seule ligne :
Merci mais malheureusement cela ne semble pas fonctionner même avec les modifications à apporter. Pour info, le fichier à importer se trouve dans "G:Posit_Devises_ddmmmyy" et le fichier ouvert a comme nom "Métaux 2.xls". Déjà je ne suis pas certain d'avoir copié le code au bon endroit (Module ?). Je n'arrive pas à importer le fichier ; ce qui est le plus important car je pourrais me passer de l'effacement des lignes.
Encore merci
"FFO" a écrit :
Salut à toi
Soit Mon document le classeur avec en Feuil1 colonne A à partir de la ligne 2 la liste des noms
Je te propose ce code :
With Application.FileSearch .LookIn = "C:Chemin" .FileType = msoFileTypeExcelWorkbooks .Execute End With With Application.FileSearch Donnée = 0 For I = 1 To .FoundFiles.Count If Mid(.FoundFiles(I), Len(.LookIn) + 2) Like "ABC*" Then If CDate(Mid(.FoundFiles(I), Len(.LookIn) + 6, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 8, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 10, 2)) > CDate(Donnée) Then Donnée = CDate(Mid(.FoundFiles(I), Len(.LookIn) + 6, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 8, 2) & "/" & Mid(.FoundFiles(I), Len(.LookIn) + 10, 2)) Fichier = Mid(.FoundFiles(I), Len(.LookIn) + 2) End If End If Next I .Application.Workbooks.Open Filename:="C:Chemin" & Fichier End With ActiveSheet.Copy Workbooks("Mon document").ActiveSheet ActiveSheet.Move after:=Sheets(Sheets.Count) Workbooks(Fichier).Close J = ActiveSheet.Range("A65535").End(xlUp).Row Do While J > 1 Ligne = 0 On Error Resume Next Ligne = Sheets("Feuil1").Range("A1", "A" & Sheets("Feuil1").Range("A65535").End(xlUp).Row).Find(What:¬tiveSheet.Range("A" & J), after:=Sheets("Feuil1").Range("A1"), LookIn:=xlValues, _ LookAt:=xlWhole).Row If Ligne = 0 Then ActiveSheet.Rows("" & J & ":" & J & "").Delete End If J = J - 1 Loop
Actualises les parties :
C:Chemin de l'adresse du répertoire Mon document du nom de ton classeur Feuil1 du nom de la feuille portant la liste
Attention ces groupes de lignes sont à mettre bout à bout en 1 seule ligne :
Peux tu me transmettre tes fichiers (fichier à importer et de recopie) en l'état avec leur nom de baptême en format .Zip par :
http://www.cijoint.fr/index.php
Communiques moi le lien pour que je les récupère
Merci
ericlbt
Voici les liens pour les fichiers : http://www.cijoint.fr/cjlink.php?file=cj200903/cijkKHtUJK.xls http://www.cijoint.fr/cjlink.php?file=cj200903/cijpCnUMQP.xls
Merci.
"FFO" a écrit :
Rebonjour à toi
Peux tu me transmettre tes fichiers (fichier à importer et de recopie) en l'état avec leur nom de baptême en format .Zip par :
http://www.cijoint.fr/index.php
Communiques moi le lien pour que je les récupère
Merci
Voici les liens pour les fichiers :
http://www.cijoint.fr/cjlink.php?file=cj200903/cijkKHtUJK.xls
http://www.cijoint.fr/cjlink.php?file=cj200903/cijpCnUMQP.xls
Merci.
"FFO" a écrit :
Rebonjour à toi
Peux tu me transmettre tes fichiers (fichier à importer et de recopie) en
l'état avec leur nom de baptême en format .Zip par :
Voici les liens pour les fichiers : http://www.cijoint.fr/cjlink.php?file=cj200903/cijkKHtUJK.xls http://www.cijoint.fr/cjlink.php?file=cj200903/cijpCnUMQP.xls
Merci.
"FFO" a écrit :
Rebonjour à toi
Peux tu me transmettre tes fichiers (fichier à importer et de recopie) en l'état avec leur nom de baptême en format .Zip par :
http://www.cijoint.fr/index.php
Communiques moi le lien pour que je les récupère
Merci
ericlbt
Voici les liens : http://www.cijoint.fr/cjlink.php?file=cj200903/cijkKHtUJK.xls
Peux tu me transmettre tes fichiers (fichier à importer et de recopie) en l'état avec leur nom de baptême en format .Zip par :
http://www.cijoint.fr/index.php
Communiques moi le lien pour que je les récupère
Merci
FFO
Salut à toi
Dans le répertoire que tu m'as donné :
G:Posit_Devises_ddmmmyy
Mets le fichier que tu récupèrera de ce lien en le renommant : "Métaux 2.xls" Mets tes fichiers à recopier dans celui-ci qui doivent être intitullés sous la forme "ABC_jjmmaa.xls" tel que tu l'avais spécifié au départ Exemple : ABC_120309.xls
Ouvre le fichier "Métaux 2.xls" et onglet "Mots" actives le bouton "Import" Un onglet sera créé à droite de ceux existant Vérifies son contenu et dis moi !!!!
Mets le fichier que tu récupèrera de ce lien en le renommant : "Métaux 2.xls"
Mets tes fichiers à recopier dans celui-ci qui doivent être intitullés sous
la forme "ABC_jjmmaa.xls" tel que tu l'avais spécifié au départ
Exemple : ABC_120309.xls
Ouvre le fichier "Métaux 2.xls" et onglet "Mots" actives le bouton "Import"
Un onglet sera créé à droite de ceux existant
Vérifies son contenu et dis moi !!!!
Mets le fichier que tu récupèrera de ce lien en le renommant : "Métaux 2.xls" Mets tes fichiers à recopier dans celui-ci qui doivent être intitullés sous la forme "ABC_jjmmaa.xls" tel que tu l'avais spécifié au départ Exemple : ABC_120309.xls
Ouvre le fichier "Métaux 2.xls" et onglet "Mots" actives le bouton "Import" Un onglet sera créé à droite de ceux existant Vérifies son contenu et dis moi !!!!
