VB/VBA Excel: petit script mais ?

VB/VBA Excel: petit script mais ? - VB/VBA/VBS - Programmation

Marsh Posté le 08-03-2005 à 21:20:13    

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

Reply

Marsh Posté le 08-03-2005 à 21:20:13   

Reply

Marsh Posté le 09-03-2005 à 23:06:47    

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!
Reply

Marsh Posté le 09-03-2005 à 23:29:57    

Sinon, voici un premier jet de code:
 

Code :
  1. Sub Test()
  2.  
  3.   Dim iI As Integer
  4.   Dim sMe As String
  5.   Dim sOpenWbk As String
  6.   Dim vI As Variant
  7.  
  8.   sMe = ActiveWorkbook.Name
  9.   iI = 1
  10.  
  11.   With Application.FileSearch
  12.     .LookIn = "E:\My Documents\Excel"
  13.     .FileType = msoFileTypeExcelWorkbooks
  14.     If .Execute() > 0 Then
  15.       For Each vI In .FoundFiles
  16.         Workbooks.Open (vI)
  17.         sOpenWbk = ActiveWorkbook.Name
  18.         Sheets(1).Activate
  19.         Columns("H" ).EntireColumn.Copy
  20.         Workbooks(sMe).Activate
  21.         ActiveSheet.Paste Cells(1, iI)
  22.         Application.DisplayAlerts = False
  23.         Workbooks(sOpenWbk).Close (False)
  24.         Application.DisplayAlerts = True
  25.         iI = iI + 1
  26.       Next vI
  27.     Else
  28.       MsgBox "Pas de fichier trouvé dans ce répertoire."
  29.     End If
  30.   End With
  32. 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

---------------
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!
Reply

Marsh Posté le 12-03-2005 à 15:26:11    

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
Reply

Marsh Posté le 14-03-2005 à 15:00:54    

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


---------------
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!
Reply

Marsh Posté le 14-03-2005 à 16:35:03    

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 :
  1. Option Explicit
  3. Sub AutoExec()
  4.     Dim fso As New Scripting.FileSystemObject
  5.     Dim fil As Scripting.File
  6.     Dim wkb As Excel.Workbook
  7.     Dim first As Boolean
  8.     Dim continue As Boolean
  9.     Dim i As Integer
  10.     Dim j As Long
  11.     Dim jlocal As Long
  12.     Dim nbCols As Integer
  13.     Dim localWorkBook As Excel.Workbook
  14.    
  15.     Set localWorkBook = ActiveWorkbook
  16.     first = True
  17.     jlocal = 1
  18.     For Each fil In fso.GetFolder(Me.Path & "\files" ).Files
  19.         Set wkb = Workbooks.Open(fil.Path, False, True)
  20.         continue = True
  21.         If first Then
  22.             j = 1
  23.             For i = 1 To 255
  24.                 If wkb.Sheets(1).Cells(j, i).Value = "" Then
  25.                     nbCols = i - 1
  26.                     Exit For
  27.                 End If
  28.                 Me.Sheets(1).Cells(jlocal, i) = wkb.Sheets(1).Cells(j, i)
  29.             Next
  30.             first = False
  31.             jlocal = jlocal + 1
  32.         End If
  33.        
  34.         For j = 2 To 65535
  35.             For i = 1 To nbCols
  36.                 Me.Sheets(1).Cells(jlocal, i).NumberFormat = "@"
  37.                 Me.Sheets(1).Cells(jlocal, i) = wkb.Sheets(1).Cells(j, i)
  38.             Next
  39.             jlocal = jlocal + 1
  40.             If jlocal = 65536 Then
  41.                 MsgBox ("Y'a plus de place dans le fichier !" )
  42.                 Exit Sub
  43.             End If
  44.             If wkb.Sheets(1).Cells(j + 1, 1).Value = "" Then
  45.                 Exit For
  46.             End If
  47.         Next
  48.         wkb.Close
  49.         Set wkb = Nothing
  50.     Next
  51. 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.

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed