laurent56380
Messages postés21Date d'inscriptionvendredi 18 janvier 2008StatutMembreDernière intervention27 janvier 2008
-
19 janv. 2008 à 17:48
laurent56380
Messages postés21Date d'inscriptionvendredi 18 janvier 2008StatutMembreDernière intervention27 janvier 2008
-
21 janv. 2008 à 03:12
Bonjour,
Voilà mon problème.
J'ai 3000 fichiers dans un répertoire.
Ces fichiers sont tous de format identiques.
Ils contiennent seulement des N° dans 9 cellules (1 Nombre à 3 chiffres par cellule) ( ex: cellule A1= 100, A2=101 A3 =205 etc juqu'a A9=905).
Puis sur une autre ligne plus bas, autre chose avec des N° différents.
Je voudrais récupérer les données de chaque fichier.
Puis les coller dans une feuille.
Chaque ligne A1:A9 de chaque feuille de mes 3000 fichiers dans une feuille1, puis chaque ligne C1:C9 de chaque feuille de mes 300 fichiers dans une autre feuille etc ...
Pour me retrouver au final avec dans chaque feuille, 26000 lignes archivées.
L'idéal serait d'avoir une macro qui n'ouvre pas les 3000 fichiers puisque chacun fait 3M0.
Pour moi qui ne maitrise pas le VBA, c'est une montagne ce problème.
Si vous avez une solution cela m'aiderai énormément.Mais est ce possible?
Merci d'avance.
Laurent
laurent56380
Messages postés21Date d'inscriptionvendredi 18 janvier 2008StatutMembreDernière intervention27 janvier 2008 19 janv. 2008 à 21:40
Bonjour et merci de vous pencher sur mon problème.
Mes fichiers sont tous des fichiers xls.
Au pire je veux bien ouvrir les fichiers par paquet de 80, ( ce que mon Pc accèpte)mais après au lieu de faire des copier collé à la main, je souhaiterai avoir une macro pour simplifier la chose.
Surtout que toutes les plages que je récupèrent sont aux mêmes endroits.
Laurent
cs_MPi
Messages postés3877Date d'inscriptionmardi 19 mars 2002StatutMembreDernière intervention17 août 201823 19 janv. 2008 à 21:53
Il ne s'agit pas d'ouvrir une série de fichiers en même temps.
Mais plutôt une simple boucle pour ouvrir chaque fichier du répertoire (Workbooks.Open), un à un, faire les copies qu'il faut et les refermer au fur et à mesure.
Fait une recherche sur la fonction DIR dans ton aide et sur ce site. Tu devrais trouver ton bonheur.
Une fois la boucle de lecture complétée (avec DIR), il te restera à copier les cellules A1:A9 et C1:C9 dans le fichier en cours en vérifiant la première ligne vide où coller ces données.
PremierLigneVide = Cells(Rows.Count, "A").End(xlUp).Row + 1
Regarde aussi les commandes Copy et PasteSpecial si tu ne les connais pas...
MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
laurent56380
Messages postés21Date d'inscriptionvendredi 18 janvier 2008StatutMembreDernière intervention27 janvier 2008 19 janv. 2008 à 23:40
Merci du coup de main,
J'ai trouvé ce qu'il me faut.
Cette macro que j'ai adapté, va chercher la plage que je souhaite sans ouvrir aucun fichier.
Elle colle les plages dans la feuille encourt à partir de la 4ème ligne et les transpose.
Puis elle recopie la suite toutes les 9 lignes.
Mes plages font toujour 9 cellules horizontales et il me les fallait à la suite à la verticale.
Génial.
Que de temps gagné et pas de risque d'erreurs.
Merci
Laurent
Sub rapatriement()
Dim Fich As String, Ligne As Long
Const Chemin = "D:\ABC\essai"
Ligne = 4
Fich = Dir(Chemin & "\*.xl*")
Do While Fich <> ""
Workbooks.Open Filename:=Chemin & Fich
Sheets("Feuil1").Select
Range("A1:J2").Copy
laurent56380
Messages postés21Date d'inscriptionvendredi 18 janvier 2008StatutMembreDernière intervention27 janvier 2008 20 janv. 2008 à 00:14
Oui mais un petit problème quand même.
La macro marche bien, mais comme mes fichiers se nommes 01(01.10.1999).xls à 3000(20.01.2008).xls la macro ne me range pas tout dans l'ordre.
A partir du fichier 10 elle prend le fichier 100.
Quoi faire, dois-je renomer tous mes fichiers en les faisant précéder d'un "A"?
Laurent
cs_MPi
Messages postés3877Date d'inscriptionmardi 19 mars 2002StatutMembreDernière intervention17 août 201823 20 janv. 2008 à 01:02
Si c'est nécessaire de conserver un ordre d'ouverture selon le nom des fichiers, le plus simple serait de les renommer. Comme tu as 3000 fichiers, ça prendrait un numéro de 4 chiffres au début du nom des fichiers.
En te servant de la même boucle que tu as et qui utilise DIR, tu passes un premier coup et tu renommes la partie de gauche du fichier. Si le format est toujours comme tu l'indiques, ie des chiffres, une parenthèse ouvrante et le reste, tu peux utiliser Split sur cette parenthèse.
ex:
Dim Fich As String, Chemin As String
Dim Tablo() As String
Chemin = "C:" 'le vrai chemin
Fich = Dir("C:\*.xl*")
Do While Fich <> ""
'sépare le nom du fichier en 2 parties Tablo(0) et Tablo(1)
Tablo = Split(Fich, "(")
'renomme le fichier
Name Chemin & Fich As _
Chemin & Format(Tablo(0), "0000") & "(" & Tablo(1)
Fich = Dir
Loop
Donc, si le nom du fichier est 01(01.10.1999).xls
il se nommera dorénavant 0001(01.10.1999).xls
Fait un test pour commencer en utilisant le pas-à-pas (F8)
Note que ma variable chemin est différente de la tienne. C'est vraiment le chemin et pas de *.xl*
Ensuite, tu peux reprendre ton autre code.
Et si l'ordre n'est toujours pas respecté, il faudra que tu utilises une listbox, un tableau, ou autre... pour stocker les noms et les trier. Ensuite, tu boucles cette liste pour lire les fichiers.
MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
laurent56380
Messages postés21Date d'inscriptionvendredi 18 janvier 2008StatutMembreDernière intervention27 janvier 2008 20 janv. 2008 à 01:16
Oui le but de la macro est bien de ranger les données par date, car je les analyses ensuite, donc si une journée passe devant une autre, tout est faux.
J'ai essayé en renomant les fichiers mais c'est la même chose.
J'ai mis 3 zéro davant le nom
arrivé au fichier 10, il ouvre ensuite le 100 au lieu du 11.
Et je ne sais pas comment faire pour la liste box ou le tableau.
Je ne connais pas grand chose en VBA.
Et dire que j'y étais presque.
Laurent
cs_MPi
Messages postés3877Date d'inscriptionmardi 19 mars 2002StatutMembreDernière intervention17 août 201823 20 janv. 2008 à 01:26
En conservant le même code, tu ajoutes une ligne pour charger une listbox
Chemin = "C:" 'le vrai chemin
Fich = Dir("C:\*.xl*")
Do While Fich <> ""
'sépare le nom du fichier en 2 parties Tablo(0) et Tablo(1)
Tablo = Split(Fich, "(")
'renomme le fichier
Name Chemin & Fich As _
Chemin & Format(Tablo(0), "0000") & "(" & Tablo(1)
Listbox1.AddItem Chemin & Format(Tablo(0), "0000") & "(" & Tablo(1)
Fich = Dir
Loop
Une fois cette boucle terminée, il faudra la trier si tu es sous Excel. Les listbox n'ont pas la propriété Sorted comme sous VB6... dommage.
Pour le tri, tu devrais trouver sur le site... Là je dois aller souper.
Si tu ne trouves j'y reviendrai...
MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
laurent56380
Messages postés21Date d'inscriptionvendredi 18 janvier 2008StatutMembreDernière intervention27 janvier 2008 20 janv. 2008 à 02:25
j'ai essayé de faire au mieux, mais cela bloque sur la ligne
Listbox1.AddItem Chemin & Format(Tablo(0), "0000") & "(" & Tablo(1)
tout passe en jaune
et il me répond erreur d'exécution 424
Pourtant lorsque je vais dans le répertoire des fichiers, il change bien le nom du 1er fichier.
le 01(01.10.1999).xls devient le 0001(01.10.1999).xls
laurent56380
Messages postés21Date d'inscriptionvendredi 18 janvier 2008StatutMembreDernière intervention27 janvier 2008 20 janv. 2008 à 02:33
voici le code si cela peu vous aider à me dépanner.
Sub rapatriement()
Dim Fich As String, Chemin As String
Dim Tablo() As String
Chemin = "D:\ABC\Laurent\Archives complètes"
Fich = Dir("D:\ABC\Laurent\Archives complètes\*.xl*")
Ligne = 4
Do While Fich <> ""
'sépare le nom du fichier en 2 parties Tablo(0) et Tablo(1)
Tablo = Split(Fich, "(")
'renomme le fichier
Name Chemin & Fich As _
Chemin & Format(Tablo(0), "0000") & "(" & Tablo(1)
Listbox1.AddItem Chemin & Format(Tablo(0), "0000") & "(" & Tablo(1)
Fich = Dir
Loop
Workbooks.Open Filename:=Chemin & Fich
Sheets("Feuil1").Select
Range("A1:J2").Copy
cs_MPi
Messages postés3877Date d'inscriptionmardi 19 mars 2002StatutMembreDernière intervention17 août 201823 20 janv. 2008 à 02:59
Sans vraiment pouvoir vraiment tester, ça devrait ressembler à ça...
Sub Rapatriement()
Dim Fich As String, Chemin As String
Dim TabloTmp() As String, TabloFichiers() As String
Dim I As Integer, J As Integer, Idx As Integer
Ligne = 4
Idx = 0 'Index utilisé pour le tableau dynamique de fichier
ReDim TabloFichiers(0) 'initialiser le tableau
'Boucle pour renommer les fichiers
'et charger un tableau avec les noms de ces fichiers
Do While Fich <> ""
'sépare le nom du fichier en 2 parties Tablo(0) et Tablo(1)
TabloTmp = Split(Fich, "(")
'renomme le fichier
Name Chemin & Fich As _
Chemin & Format(TabloTmp(0), "0000") & "(" & TabloTmp(1)
'Charge le tableau de fichiers
ReDim Preserve TabloFichiers(Idx)
TabloFichiers(Idx) = _
Format(TabloTmp(0), "0000") & "(" & TabloTmp(1)
Idx = Idx + 1
Fich = Dir
Loop
Trier TabloFichiers 'Appel de la procédure de tri pour le tableau de fichiers
'Boucler le tableau trié des fichiers (plus besoin du DIR)
For I = 0 To UBound(TabloFichiers)
Workbooks.Open Chemin & TabloFichiers(I)
Sheets("Feuil1").Select
Range("A1:J2").Copy
Ligne = Ligne + 9
Workbooks(TabloFichiers(I)).Close False
Next
End Sub
Sub Trier(Tablo)
Dim I As Integer, J As Integer
Dim strTemp As String
For I = 0 To UBound(Tablo)
For J = I To UBound(Tablo)
If Tablo(I) > Tablo(J) Then
strTemp = Tablo(I)
Tablo(I) = Tablo(J)
Tablo(J) = strTemp
End If
Next
Next
End Sub
MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
laurent56380
Messages postés21Date d'inscriptionvendredi 18 janvier 2008StatutMembreDernière intervention27 janvier 2008 20 janv. 2008 à 03:28
Un grand merci pour tout le temps que vous passez à m'aider.
J'ai essayé la macro.
Elle plante à cette ligne.
Name Chemin & Fich As _
Chemin & Format(TabloTmp(0), "0000") & "(" & TabloTmp(1)
Mais elle renome bien tous les fichiers.
Laurent
cs_MPi
Messages postés3877Date d'inscriptionmardi 19 mars 2002StatutMembreDernière intervention17 août 201823 20 janv. 2008 à 03:33
Peut-être est-ce parce que le fichier porte le même nom (?)
Essaie comme ceci
If Chemin & Fich <> Chemin & Format(TabloTmp(0), "0000") & "(" & TabloTmp(1) Then
Name Chemin & Fich As _
Chemin & Format(TabloTmp(0), "0000") & "(" & TabloTmp(1)
End If
MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI
laurent56380
Messages postés21Date d'inscriptionvendredi 18 janvier 2008StatutMembreDernière intervention27 janvier 2008 21 janv. 2008 à 02:02
J'ai essayé mais çà bloque toujours au même endroit.
Là ou j'ai mis la ligne en rouge.
Voici le code
Sub Rapatriement()
Dim Fich As String, Chemin As String
Dim TabloTmp() As String, TabloFichiers() As String
Dim I As Integer, J As Integer, Idx As Integer
Ligne = 4
Idx = 0 'Index utilisé pour le tableau dynamique de fichier
ReDim TabloFichiers(0) 'initialiser le tableau
'Boucle pour renommer les fichiers
'et charger un tableau avec les noms de ces fichiers
Do While Fich <> ""
'sépare le nom du fichier en 2 parties Tablo(0) et Tablo(1)
TabloTmp = Split(Fich, "(")
'renomme le fichier
If Chemin & Fich <> Chemin & Format(TabloTmp(0), "0000") & "(" & TabloTmp(1) Then
Name Chemin & Fich As _
Chemin & Format(TabloTmp(0), "0000") & "(" & TabloTmp(1)
End If
'Charge le tableau de fichiers
ReDim Preserve TabloFichiers(Idx)
TabloFichiers(Idx) = _
Format(TabloTmp(0), "0000") & "(" & TabloTmp(1)
Idx = Idx + 1
Fich = Dir
Loop
Trier TabloFichiers 'Appel de la procédure de tri pour le tableau de fichiers
'Boucler le tableau trié des fichiers (plus besoin du DIR)
For I = 0 To UBound(TabloFichiers)
Workbooks.Open Chemin & TabloFichiers(I)
Sheets("Feuil1").Select
Range("A1:J2").Copy
Ligne = Ligne + 9
Workbooks(TabloFichiers(I)).Close False
Next
End Sub
Sub Trier(Tablo)
Dim I As Integer, J As Integer
Dim strTemp As String
For I = 0 To UBound(Tablo)
For J = I To UBound(Tablo)
If Tablo(I) > Tablo(J) Then
strTemp = Tablo(I)
Tablo(I) = Tablo(J)
Tablo(J) = strTemp
End If
Next
Next
End Sub