VB/VBA Excel: petit script mais ?

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : VB/VBA Excel: petit script mais ?

nick_olas

Antiquaire en VGA :o

Bonjour,

Je souhaite regrouper dans un seul fichier .xls des données provenant de 400 fichiers .xls.
Chaque fichier reprend simplement la mesure d'une variable (toujours dans la colonne H de la première feuille ) quotidienne durant un an (jours ouvrable).
Il faudrait donc un programme ou un script qui ouvre les tous les fichiers présents dans un répertoire donné et copie la colonne H de la première feuille dans un fichier .xls

Je pense que ça doit être possible en VBA mais j'avoue que mes cours sont loins

Merci d'avance si quelqu'un connait un moyen simple de faire ça

Publicité

AlainTech

Pas trouvé? Cherche encore!

En voulant écrire un code pour ton problème, je me rends compte qu'une feuille Excel ne peut avoir plus de 256 colonnes (Excel97)
Or, tu veux y mettre les colonnes H de tes 400 fichiers.
Où va-t-on les mettre?

---------------
Si on vous donne une info qui marche, DITES-LE!!!! ------ Si vous trouvez seul, AUSSI, votre solution peut servir à d'autres! ------ Je dois la majorité de mes connaissances à mes erreurs!

AlainTech

Pas trouvé? Cherche encore!

Sinon, voici un premier jet de code:

Code :

Sub Test()
Dim iI As Integer
Dim sMe As String
Dim sOpenWbk As String
Dim vI As Variant
sMe = ActiveWorkbook.Name
iI = 1
With Application.FileSearch
.LookIn = "E:\My Documents\Excel"
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For Each vI In .FoundFiles
Workbooks.Open (vI)
sOpenWbk = ActiveWorkbook.Name
Sheets(1).Activate
Columns("H" ).EntireColumn.Copy
Workbooks(sMe).Activate
ActiveSheet.Paste Cells(1, iI)
Application.DisplayAlerts = False
Workbooks(sOpenWbk).Close (False)
Application.DisplayAlerts = True
iI = iI + 1
Next vI
Else
MsgBox "Pas de fichier trouvé dans ce répertoire."
End If
End With
End Sub

Si ça peut t'ouvrir une piste pour continuer...
Attention, si un des classeurs a du code dans l'event WorkbookOpen, il sera exécuté.

Message édité par AlainTech le 10-03-2005 à 20:00:30

nick_olas

Antiquaire en VGA :o

Merci beaucoup je vais essayer ça
En fait j'aurai peut être plus de fichiers (genre un millier) donc je scindrai en 5 gros fichiers centraux.

edit: le programme me fait juste une erreur "400"
Je peux t'envoyer trois fichiers par mail pour que tu fasses un essai?
Merci

Message édité par nick_olas le 12-03-2005 à 20:38:48

AlainTech

Pas trouvé? Cherche encore!

T'ai répondu par MP.
N'ai pas encore reçu de fichier.

Arjuna

Aircraft Ident.: F-MBSD

Bon, en lisant ce topic, j'ai pensé que j'avais promi de faire ce type de macro pour un collègue.

Voilà donc ce que je lui ai pondu :

Code :

Option Explicit
Sub AutoExec()
Dim fso As New Scripting.FileSystemObject
Dim fil As Scripting.File
Dim wkb As Excel.Workbook
Dim first As Boolean
Dim continue As Boolean
Dim i As Integer
Dim j As Long
Dim jlocal As Long
Dim nbCols As Integer
Dim localWorkBook As Excel.Workbook
Set localWorkBook = ActiveWorkbook
first = True
jlocal = 1
For Each fil In fso.GetFolder(Me.Path & "\files" ).Files
Set wkb = Workbooks.Open(fil.Path, False, True)
continue = True
If first Then
j = 1
For i = 1 To 255
If wkb.Sheets(1).Cells(j, i).Value = "" Then
nbCols = i - 1
Exit For
End If
Me.Sheets(1).Cells(jlocal, i) = wkb.Sheets(1).Cells(j, i)
Next
first = False
jlocal = jlocal + 1
End If
For j = 2 To 65535
For i = 1 To nbCols
Me.Sheets(1).Cells(jlocal, i).NumberFormat = "@"
Me.Sheets(1).Cells(jlocal, i) = wkb.Sheets(1).Cells(j, i)
Next
jlocal = jlocal + 1
If jlocal = 65536 Then
MsgBox ("Y'a plus de place dans le fichier !" )
Exit Sub
End If
If wkb.Sheets(1).Cells(j + 1, 1).Value = "" Then
Exit For
End If
Next
wkb.Close
Set wkb = Nothing
Next
End Sub

Fonctionnement :

Citation :

Mettre vos fichiers à Merger dans le répertoire "files".
Ils doivent répondent aux critères :
1/ Première ligne = entête
2/ Il doivent toujours avoir la même structure (colonnes dans le même ordre, etc.)
3/ Première colonne obligatoirement remplie pour toutes les lignes

Ensuite, ouvrir le fichier "Merge.xls", et lancer la macro "AutoExec" si elle ne démarre pas toute seule.

Normalement, au bout de quelques secondes, tous les fichiers doivent être réunis dans le fichier "merge.xls".

PS: Cette macro ne fais pas exactement ce qui est demandé initialement.

Ici, on a X fichier contenant des données. Ils ont tous la même structure. On veut les merger en un seul fichier.

FORUM HardWare.fr

Programmation

VB/VBA/VBS

VB/VBA Excel: petit script mais ?

Sujets relatifs
programation action script	vba : excel, supprimer des images
Script pour connaitre les sessions creees sous Apache?	excel aide macro pr comparer des lignes
Script qui detecte l'url tapé	[Excel] débutant cherche à comparer des dates...
[C#] DataRow.ItemArray.SetValue petit soucis	[VB]Manip fichier Excel+chemin depuis VB
[Access/VBA]Subclasser une form => Paint?	Un petit code php a modifié (5 lignes) lisez tous c'est intéressant :)
Plus de sujets relatifs à : VB/VBA Excel: petit script mais ?

Page générée en 0.056 secondes