[MACRO] 6 fichiers indiv => 1 fichier complet

[lo]

[MACRO] 6 fichiers indiv => 1 fichier complet

Bonjour le forum!

Dans le but d'automatiser mon outil de recherche, je souhaiterai monter une macro qui mette à jour le fichier chaque nuit à 00.00.
Petit pb, je ne suis pas des meilleurs en macro...

J'ai 6 fichiers .xls mis à jour quotidiennement par mes collégues et moi même. Dans ces fichiers chaque jour sont maj une ou plusieurs lignes depuis un userform.

Deux solutions donc :
1/ lorsque qu'une information est saisie elle l'est dans les deux fichiers. L'un indiv, et l'autre général.
ou
2/ chaque jour à minuit tourne une macro qui vide le fichier général puis récupere les infos des 6 fichiers indiv. (anciennes et nouvelles data).

Kel solution adoptée (la moins lourde possible sachant que mon pc reste allumé 24/24) et dans le cas de la macro comment se présenterait elle ?

Par avance merci,
et bonne semaine à tous/toutes!

 

[@+Thierry]

Re: [MACRO] 6 fichiers indiv => 1 fichier complet

Bonjour Lo, le Forum

Les deux solutions sont réalisables.

La Première risque de ralentir le traitement puisque l'on va faire une ouverture du classeur général à chaque ajout puis sauvegarde et fermeture...

La Seconde nécessite une parfaite structure identique des six fichiers pour éviter les catastrophes....

Imaginons pour la première, il suffit de faire quelques lignes de plus dans le bouton de validation de ton UserForm :

Workbooks.Open "H:\Share\General.xls"
With ActiveWorkBook..Sheets("Collection")
L = .Range("A65536").End(xlUp).Row + 1

.Range("A" & L) = TextBox1
etc etc etc
End With
ActiveWorkBook.Close True

Imaginons pour la seconde que tous les fichiers copier soient dans le même répertoire... et qu'ils contiennent des données linéaires de A à D...

Sub CollectingFiles()
Dim F As Variant
With Application.FileSearch
.NewSearch
.Filename = "*.XLS"
.LookIn = "I:\MC_Dev\Apollo\DiaryJune\Test\"
.Execute
On Error Resume Next
For Each F In .FoundFiles
Workbooks.Open F
CollectingInfo ActiveWorkbook
Next F
End With
End Sub

Sub CollectingInfo(File As Workbook)
Dim LC As Integer, LS As Integer
Dim PlageSource As Variant
Dim WSCible As Worksheet

Set WSCible = ThisWorkbook.Sheets("Collection")

With File.Sheets(1)
LS = .Range("D65536").End(xlUp).Row
PlageSource = .Range("A1" & LS)
End With


LC = WSCible.Range("A65536").End(xlUp).Row + 1

For i = 1 To LS
WSCible.Cells(LC + i, 1) = File.Name
Next

WSCible.Range("B" & LC + 1 & ":E" & LC + LS) = PlageSource

File.Close 0

End Sub

Je te laisse faire des essaies....

Bon App, je file déjeuner
@+Thierry

 

[lo]

Re: [MACRO] 6 fichiers indiv => 1 fichier complet

Vu la lenteur du réseau ici, je vais tester de suite ta seconde proposition.
Les 6 fichiers sont rigoureusement identiques, le général le sera tout autant...
Je file eplucher ton code.

Merci ! & bonne digestion

 

[lo]

Re: [MACRO] 6 fichiers indiv => 1 fichier complet

Re,

Je viens de tester et j'ai déjà du faire une err qq part,
.FileName = "*.XLS" me renvois => err d'execution "5"
Argument ou appel de procédure incorrect. (je tourne avec excel 97)

J'en profiter pour détailler un peu plus ma demande,
j'ai six fichiers (nom1.xls, nom2.xls etc) avec des col de A à T. Je souhaite récupérer les valeurs de chaque fichier depuis la ligne 7. Les colonnes : A C D E F G J N R S et T m'intéresse (exit donc B, H, I, K, L, M, O, P, Q ça fera toujours ça de lourd en moins dans un 7ieme fichier appelé gnl.xls
Tous sont sur le réseau (au cas ou cela est son importance), disque N:\

Je retourne déchiffrer le code de Thierry,

 

[@+Thierry]

Re: [MACRO] 6 fichiers indiv => 1 fichier complet

Re Bonjour Lo

Arf Excel 97 !!!, juste à moi qui suis pratiquemnent allergique !! lol

Bon çà n'est pas encore définitivement fichu, mais il va falloir truquer alors...

Pour ce qui est des colonnes, non c'est plus simple de tout récupérer car on passe en Tableau Array, ça n'a pas d'importance. Ensuite un macro sur le Fichier général pourra faire le ménage des colonnes non désirées.

Bobn alors au lieu d'utiliser FileSearch qui plante donc apparemment sous ce bon vieux Excel 97, on va faire ceci :

Sub CollectingTheFiles()
Dim TheArrayOfBooks As Variant
Dim WB As Variant
Dim ThePath As String
ThePath = "I:\MC_Dev\Apollo\DiaryJune\Test\"

TheArrayOfBooks = Array("toto.xls", "lolo.xls", "zaza.xls") 'j'en ai fais que trois pour mes tests !!!

For Each WB In TheArrayOfBooks
Workbooks.Open ThePath & WB
CollectingInfo ActiveWorkbook
Next

End Sub


Sub CollectingInfo(File As Workbook)
Dim LC As Integer, LS As Integer
Dim PlageSource As Variant
Dim WSCible As Worksheet

Set WSCible = ThisWorkbook.Sheets("Collection")

With File.Sheets(1)
LS = .Range("D65536").End(xlUp).Row
PlageSource = .Range("A7:T" & LS)
End With

LC = WSCible.Range("A65536").End(xlUp).Row + 1

For i = 1 To LS - 6
WSCible.Cells(LC + i, 1) = File.Name
Next

WSCible.Range("B" & LC + 1 & ":U" & LC + LS - 6) = PlageSource

File.Close 0
End Sub


Dis moi si ça convient mieux ?

@+Thierry

 

[lo]

Re: [MACRO] 6 fichiers indiv => 1 fichier complet

lol
désolé de t'ennuyer sur une version aussi agée mais tu verrais l'organisme pour lequel nous travaillons tu comprendrais de suite ;-))

Set WSCible = ThisWorkbook.Sheets("Collection") semble posé une err:
Erreur d'éxécution '9':
Indice en dehors de la plage.

Pour info j'ai modifié :
TheArrayOfBooks = Array("loic.xls", "touré.xls")

en en mode débug, seul le fichier loic.xls a été ouvert
tu vois dans ton code tu n'étais pas loin de trouver un prénom ^^

Dois je modifier "Collection" par qq ch ?

 

[lo]

Re: [MACRO] 6 fichiers indiv => 1 fichier complet

J'ai modifié collection par le nom "gnl" et cela semble ok ... Il m'a juste rajouté une colonne avec le nom du fichier importé (ce qui est parfait).
J'ai fait le test avec 2 fichiers, cela a pris qq temps.
Est-il possible d'automatiser le fichier de tel sorte qu'il soit chaque jour à mon arriver MAJ auto ?!

 

[@+Thierry]

Re: [MACRO] 6 fichiers indiv => 1 fichier complet

Re Lo

Pour que ce Code fonctionne, il faut que dans le Classeur où il se trouve (le Code) il existe une feuille nommée "Collection"...Ou alors tu la nomme comme tu veux et tu modifie cette ligne en conséquence.

Pour le bug d'avant, je repensais à un truc, il faut pour que le SearchFile ne plante pas que le Classeur où se trouve le Code NE soit PAS dans le répertoire scanné, sinon la procédure va essayer de ré-ouvrir ce classeur qui est déjà ouvert, source (peut-être du problème)

Tiens moi au courant
@+Thierry

 

[lo]

Re: [MACRO] 6 fichiers indiv => 1 fichier complet

re Thierry

eeeeh tu as mis l'accent sur l'erreur, en effet les fichiers étaient tous dans le même dossier! Des demain je réessaie le premier code de façon à choper le plus rapide des deux. Pour l'instant la maj prends 5m à tout casser.

Une idée pour la maj auto (sachant que je peux laisser le fichier ouvert pour plus de facilité?

 

[@+Thierry]

Re: [MACRO] 6 fichiers indiv => 1 fichier complet

Ah ok on s'est croisé.

Bon alors si çà tourne tant mieux, dis moi j'espère au moins que l'organisme pour lequel je participe c'est pas les préposés aux expéditions de PV des radars automatiques !!! lol

Pour ce qui est d'automatiser le fichier de tel sorte qu'il soit chaque jour à ton arrivée MAJ auto....

Oui tu peux faire avec différentes solutions...

1) le TaskManager de Windows. Tu fais ouvrir tous les jours à une heure voulue ton Fichier "Général" qui contient le code.

Dans ce Fichier "Général" tu mets ceci dans le Private Module de ThisWorkBook :

Private Sub Workbook_Open()
CollectingTheFiles '<<<< Si tu n'as pas changé le nom de la macro
End Sub

Et dans le code lui-même de la macro "CollectingTheFiles" juste avant "End Sub" mais après le Next :
Application.Quit
ThisWorkbook.Close True

C'est Tout....

AVANTAGE : Windows gère tout seul et de manière récurrante la tâche à accomplir, il ne suffit que de laisser l'ordi allumé, même pas besoin d'excel ouvert. On peut même verouiller l'ordi. Pas de risque d'oubli. (Le Windows task Scheduler se trouve depuis le panneau de configuration)


2) Une Macro en mode OnTime .
Sub ApplicationRunOnTimeMacro()
Application.OnTime TimeValue("23:00:00"), "CollectingTheFiles"
End Sub

Ensuite on peut faire la même modi pour la sauvegarde et fermeture dans la macro "CollectingTheFiles" quer précvédemment expliqué.

INCONVENIENT : Il faut penser à lancer la macro "ApplicationRunOnTimeMacro" chaque jour avant de quitter le bureau, il faut laisser Excel ouvert avec le classeur en question ouvert aussi.

Bon Aprèm
@+Thierry

 

[lo]

Re: [MACRO] 6 fichiers indiv => 1 fichier complet

Re ;-)

La solution 1 est de loin la plus intéressante, manque de pot je n'ai pas encore les droits pour l'activer (je viens d'en effectuer la demande). so wait'n'see.

Pour rappel j'ai mis dans le code de la feuille Collection :

Sub CollectingTheFiles()
Dim TheArrayOfBooks As Variant
Dim WB As Variant
Dim ThePath As String
ThePath = "N:\path\"

TheArrayOfBooks = Array("loic.xls", "touré.xls", ....) 'etc

For Each WB In TheArrayOfBooks
Workbooks.Open ThePath & WB
CollectingInfo ActiveWorkbook
Next

End Sub


Sub CollectingInfo(File As Workbook)
Dim LC As Integer, LS As Integer
Dim PlageSource As Variant
Dim WSCible As Worksheet

Set WSCible = ThisWorkbook.Sheets("Collection")

With File.Sheets(1)
LS = .Range("D65536").End(xlUp).Row
PlageSource = .Range("A7:T7" & LS)
End With

LC = WSCible.Range("A65536").End(xlUp).Row + 1

For i = 1 To LS - 6
WSCible.Cells(LC + i, 1) = File.name
Next

Application.Quit
ThisWorkbook.Close True

WSCible.Range("B" & LC + 1 & ":U" & LC + LS - 6) = PlageSource

File.Close 0

End Sub

et ce qui suit dans le code de Module1 renomé pour l'ocaz Collection:

Private Sub Workbook_Open()
CollectingTheFiles
End Sub

Rien ne se passe à l'ouverture du fichier pour l'instant. Ce qu'il ne faut pas puisque dans la journée il sera consulté par des collabs (les données de la veille).
J'ai du merdé qq part
si je place le code dans This.Workbook cela ne fonctionne pas plus (function ou sub non défini).

Et je te rassure de suite, je ne travaille pas pour l'organisme dont tu fais référence mais pour un organisme social qui aide lui les gens

Merci encore pour tout et bonne fin de journée.
Loic.

 

[@+Thierry]

Re: [MACRO] 6 fichiers indiv => 1 fichier complet

Re Loic, le Forum

Heuh non, ATTENTION c'est l'inverse ! tout à l'envers LOL !!!

La Sub CollectingTheFiles() et la Sous Sub CollectingInfo(File As Workbook) doivent se trouver dans un Module Standard du classeur "Général" (Module1 par exemple) et pas dans le code de la feuille Collection !

Donc ATTENTION !

Ensuite c'est la Macro Evènementielle "Workbook_Open" qui lancera tout le boulot.... Et Elle doit se trouver IMPERATIVEMENT dans le Private Module de "ThisWorkBook"...

Regarde ce GIF Animé :



A la place de MsgBox "Hello THe Forum XLD" tu lances simplement "CollectingTheFiles"...

Oui maintenant que tu le dis, je me souviens qu'il faut avoir les droits Admin pour le Windows Task Manager... (même pas juste PowerUser si je ne m'abuse)

Maintenant ATTENTION aussi à cette phrase "Ce qu'il ne faut pas puisque dans la journée il sera consulté par des collabs " car tel quel le fichier se mettra à jour A CHAQUE ouverture....

Donc un petit code de derrière les fagots règlera çà en remplacement du WorkBook_Open précédent :

Option Explicit

Private Sub Workbook_Open()
Dim SystemTime As Date
Dim UpdateTimeMin As Date
Dim UpdateTimeMax As Date

SystemTime = Time
UpdateTimeMin = "22:00:00"
UpdateTimeMax = "23:59:00"

If SystemTime > UpdateTimeMin And SystemTime < UpdateTimeMax Then
CollectingTheFiles

End If
End Sub

Ce qui signifie que seulement entre 22h00 et 23h59 la procédure de mise à jour s'éxécutera à l'ouverture...

Voilà sinon ravi de savoir que tu travaille pour aider les gens, c'est ce que nous essayons de faire ici sur notre temps dipo.

Bonne Fin de Journée
@+Thierry

 

[lo]

Re: [MACRO] 6 fichiers indiv => 1 fichier complet

Bonjour Thierry, Le forum

Je viens de prendre connaissance de ton message et est adapté le .xls selon tes commentaires. Petit pb, ça marchait mieux avant lorsque le code était dans la feuille Collection ?! Aujourd'hui qu'il est dans le module1 il se contente d'ouvrir le premier fichier, de copier le nom en A1 etc et c tout ...
Je ne saisi pas tout là

Par contre il n'y a plus d'err dans This.Workbook au lancement...
j'vais tenter de trouver le temps de regarder ça de façon plus approfondie, et ce après un café ;-))


Merci pour le code evenementiel.

Bonne journée,
Loic.

ps: Voilà sinon ravi de savoir que tu travaille pour aider les gens, c'est ce que nous essayons de faire ici sur notre temps dipo. => je m'en étais grandement aperçu Vais tenter de vous apporter un peu d'aide avec le peu de connaissance que j'ai si toutefois vous le souhaitez.

 

[lo]

Re: [MACRO] 6 fichiers indiv => 1 fichier complet

Re,

avec un café dans le nez.


J'ai supprimé le code entier de la feuille 'Collection'
Et J'ai mis dans le code du Module1 ce qui suit:

Sub CollectingTheFiles()
Dim TheArrayOfBooks As Variant
Dim WB As Variant
Dim ThePath As String
ThePath = "N:\path\"

TheArrayOfBooks = Array("5.xls")

For Each WB In TheArrayOfBooks
Workbooks.Open ThePath & WB
CollectingInfo ActiveWorkbook
Next

End Sub


Sub CollectingInfo(File As Workbook)
Dim LC As Integer, LS As Integer
Dim PlageSource As Variant
Dim WSCible As Worksheet

Set WSCible = ThisWorkbook.Sheets("Collection")

With File.Sheets(1)
LS = .Range("D65536").End(xlUp).Row
PlageSource = .Range("A7:T7" & LS)
End With

LC = WSCible.Range("A65536").End(xlUp).Row + 1

For i = 1 To LS - 6
WSCible.Cells(LC + i, 1) = File.name
Next

Application.Quit
ThisWorkbook.Close True

WSCible.Range("B" & LC + 1 & ":U" & LC + LS - 6) = PlageSource

File.Close 0

End Sub



Le pb décrit ds le post d'avant perdure... je pige pas ou se situe mon err grr Et le debug ne me renvoit rien de spécial...

 

[@+Thierry]

Re: [MACRO] 6 fichiers indiv => 1 fichier complet

Bonjour Lo, le Forum

Je vais te conseiller d'urgence de retourner boire un second café bien "stretto" comme disent nos voisins du Sud Est... !!! LOL

Tu as bien ceci comme Problème :"Aujourd'hui qu'il est dans le module1 il se contente d'ouvrir le premier fichier, de copier le nom en A1 etc et c tout ..."

Et bien je te parie que c'est le Fichier "N:\path\5.xls" qui est copié et seulement lui seul !

J'ai gagné ?

Bon alors tu paie l'apéro

Et tu sais pourquoi je le sais ?

Et bien par enchantement la ligne que tu décrivais le 27-07-04 16:20
TheArrayOfBooks = Array("loic.xls", "touré.xls", ....) 'etc

est devenue :
TheArrayOfBooks = Array("5.xls")

Mais que sont devenus Loic, Touré et la bande ? (lol)

Ton problème est simplement là, il n'y a pas de mystère, si tu fais une Array d'un seul item.... Seul cet item sera traité ! (Et d'ailleurs il n'y a pas besoin de faire une Array pour un seul Item)

Par Ailleurs je serai étonné que la procédure que tu viens de poster fonctionne sans embrouille tel quel....

Je te propose un jeu des septs erreurs ... (avec une seule)
Mon Post du 27-07-04 14:19 :
&nbsp;PlageSource = .Range("A7:T" & LS)

Ton Post ci-dessus :
&nbsp;PlageSource = .Range("A7:T7" & LS)

Je pense que ça ira bien mieux ensuite...

Voilà, sinon of course tu es welcome pour nous donner un coup de main sur XLD, comme chacun, dans la mesure de ses moyens.

Bonne Journée
@+Thierry