Importer/fusionner fichier et supprimer lignes

Le
ericlbt
Bonjour,

Je cherche à créer deux macros :

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.

Merci par avance pour votre aide.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
FFO
Le #18873971
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 :

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

Fais des essais et dis moi !!!!!
ericlbt
Le #18876411
Bonjour FFO,,

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 :

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

Fais des essais et dis moi !!!!!



FFO
Le #18878371
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
Le #18882791
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
Le #18882781
Voici les liens :
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
Le #18882771
Voici les liens :
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



FFO
Le #18883261
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 !!!!

http://www.cijoint.fr/cjlink.php?file=cj200903/cijAP95Njn.xls
ericlbt
Le #18885991
Et bien tout ceci semble fonctionner !!!

Merci beaucoup.
Publicité
Poster une réponse
Anonyme