Un script qui lit des fichiers excel et en produit un autre Résolu/Fermé

Question

Bonjour, 
J'ai 22 000 fichiers excels ayant la même structure (c-a-d les mêmes types d'informations se retrouve dans les mêmes adresses de cellules). Je voudrai extraire certaines informations de ces 22 000 fichiers et les écricre dans un nouveau fichier excel ou CSV. Et je veux faire ceci de manière automatique en utilisant VBSCRIPT.
Voici un algorithme en pseudo langage qui décrit ce que je veux faire. Quelqu'un peut-il l'écrire pour moi en vbscript? merci d'avance

Début algorithme

' Rep est le répertoire contenant mes 22 000 fichiers excel
variable Rep = "C:\MesFichiersExcel"

' Listing est le nouveau fichier excel ou csv à produire contenant
' sur chaque ligne les données extraites d'un fichier excel
variable Listing

Pour chaque Fichier dans Rep
     - ouvrir le fichier dans l'application excel
     - masquer l'application excel (la propriété Visible = Faux)
     - aller à la feuille de calcul numéro 1
     - copier les données des cellules A2, I20 et J20
     - ajouter ces données sur une nouvelle ligne du fichier Listing
FinPour

Fin algorithme


Configuration: Windows 7 / Internet Explorer 9.0

michel_m · Answer

Bonjour

un VBscript ? cela peut se faire en VBA et sans ouvrir tes 22000 classeurs

Tu dis...

B · Answer

comment je le fais alors en vba

B · Answer

michel, je te saurais gré pour une proposition de solution en vba

michel_m · Answer

a placer dans un module du VBE (alt+F11, insertion module) et copier-coller cette macro en adaptant le nom du chemin

Option Explicit
Option Base 1

Sub recopier()
Dim T_out()
Dim Chemin As String, Fich As String, Nom As String
Dim Cptr As Integer

'Initialisations
Application.ScreenUpdating = False
Chemin = "D:\documents\excel\essai" ' A ADAPTER
ChDir Chemin
ReDim T_out(4, 1)

'collecte des valeurs dans les classeurs
Fich = Dir("*.xls")
While Fich <> ""
     Cptr = Cptr + 1
     ReDim Preserve T_out(4, Cptr)
     T_out(1, Cptr) = Fich
     T_out(2, Cptr) = ExecuteExcel4Macro("'" & Chemin & "\[" & Fich & "]Feuil1'!R2C2")
     T_out(3, Cptr) = ExecuteExcel4Macro("'" & Chemin & "\[" & Fich & "]Feuil1'!R20C9")
     T_out(4, Cptr) = ExecuteExcel4Macro("'" & Chemin & "\[" & Fich & "]Feuil1'!R20C10")
     Fich = Dir
Wend
Range("A2:D30000").Clear
Range("A2").Resize(Cptr, 4) = Application.Transpose(T_out)

B · Answer

Bonjour Michel
Juste pour te dire merci pour ton code. il avait résolu mon problème.
Malheureusement je n'ai pas eu le temps de te dire merci à temps.