macro excel récupere donnée autres feuilles SOS urgent SVP

macro excel récupere donnée autres feuilles SOS urgent SVP - VB/VBA/VBS - Programmation

Marsh Posté le 03-05-2006 à 23:21:05    

Bonjour,
J'ai un GROS problème concernant la rédaction d'une macro excel pour mon stage de fin d'études. Je suis  a la base chimiste, et j'en peux plus de chercher sur internet des réponses... SVP aidez moi
 
Je dois récupérer des données se trouvant dans 365*4 feuilles excel, a chaque fois les même cellules: BK45-BL45-BM45-BK46-BL46-BM46-BK47-BL47-BM47-BK48-BL48-BM48 sur la feuille "Présentation" de chaque fichier.
En fait, il existe un fichier excel par jour d'ou les 365*4 car j'ai les données sur 4 ans.
L'organisation des fichiers en répertoire est la suivante:
 
E:\CD\Bilans_Journaliers_Choisy\  et après l'année, puis année\mois
voici des exemples de chemins pour le mois d'aout de l'année 2004, et le mois de janvier de l'année 2002:
E:\CD\Bilans_Journaliers_Choisy\2004\2004_08            et   E:\CD\Bilans_Journaliers_Choisy\2002\2002_01
 
apres dans le repertoire "...\2004\2004_08 se trouvent les 31 fichiers correspondant aux 31 jours. Leur nom est:
Bilan_Journalier_Usine_01_08_2004  par exemple pour celui du 1aout.
 
 
J'aimerais obtenir au final un fichier excel avec 2 information: les cellules citées ci dessus, en ligne, et le nom du fichier duquel elles ont été extraites.
 
par exemple:
 
nom du fichier dans la cellule A1 - puis apres en B1-C1 etc... le contenu des cellules BK45-BL45-BM45-BK46-BL46-BM46-BK47-BL47-BM47-BK48-BL48-BM48 (dans cet ordre) du fichier dont le nom est en A1.
 
Je dois vraiment terminer ca avant vendredi, SVP aidez moi, j'en peux plus....!!!!!
 
Bonne soirée, je vais encore passer une nuit blanche dessus :-(

Reply

Marsh Posté le 03-05-2006 à 23:21:05   

Reply

Marsh Posté le 04-05-2006 à 19:51:16    

c bon je l'ai

Reply

Marsh Posté le 10-05-2006 à 17:32:51    


 
Bonjour Pierre!!
 
Après des heures d'errement sur le net, je pense que tu détiens la solution! je souhaiterai faire à peu près la même chose que toi (en moins volumineux!)!!
 
Je te serai reconnaissant de m'envoyer les codes!!
 
En espérant que la fin de la rédaction de ton mémoire s'est bien passée, je te remercie d'avance!
 
fix

 


 

Reply

Marsh Posté le 10-05-2006 à 20:01:25    

ok, je te file la macro
par contre il persiste un petit probleme: quand la macro me copie le contenu des cellules qui m'intéressent, il copie avec la formule, j'aimerais qu'il copie "les valeurs seulement".
Si tu as la soluce, renvoie moi la macro en entier stp (répond aussi si tu l'a pas)
 
Sub Macro1()
 
' Mettre le bon chemin
Dim CheAn, Chemois, Fichxl, T_M(12) As String
Dim T_An(4), X, M, Lig As Integer
' Mise en place des noms dossiers An dans X postes
T_An(1) = 2003: T_An(2) = 2004: T_An(3) = 2005: T_An(4) = 2006
' Vous pouvez traiter An par an sur 4 feuilles et regrouper (copier/coller)
' les 4 feuilles en 1
' Tableau des dossiers Mois (juste l'élément qui varie)
T_M(1) = "01": T_M(2) = "02": T_M(3) = "03": T_M(4) = "04":
T_M(5) = "05": T_M(6) = "06": T_M(7) = "07": T_M(8) = "08":
T_M(9) = "09": T_M(10) = "10": T_M(11) = "11": T_M(12) = "12":
For X = 1 To 4      ' On boucle 4 fois pour 4 ans
   ' on charge le répertoire d'1 année T_An(X) dans la variable Chemxl
   CheAn = "E:\CD\Bilans_Journaliers_Choisy\" & T_An(X) & "\" & T_An(X) & "_"
   For M = 1 To 12    ' on va sur 12 dossiers Mois
   ' en pas à pas, on doit lire le chemin exact du dossier dans chemois
     Chemois = CheAn & T_M(M)
     ' la commande DIR met le nom du 1er .XLS du dossier chemois\... dans FichXL
     Fichxl = Dir(Chemois & "\*.XLS" )
     Do While Fichxl <> ""        ' si plus de fichier => fin
        Workbooks.Open Filename:= _
        Chemois & "\" & Fichxl
        '"C:\Documents and Settings\JPIERRE\Mes documents\Excel\LEVIER1.xls"
        'BK45, BL45, BM45
        Range("BK45:BM45" ).Select       ' on select/copy 3 cellules lig.45
        Selection.Copy
        Windows("Anmois.xls" ).Activate  ' on va sur l'XL central à la bonne ligne
        Lig = Lig + 1                   ' 1 ligne 12 cellules
        Range("A" & Lig).Select         ' Col A ligne Lig, chemin & fichier
        ActiveCell.Value = Chemois & "\" & Fichxl
        Range("B" & Lig).Select         ' Col B lig.45
        ActiveSheet.Paste
         
        Windows(Fichxl).Activate        ' on va copier la lig.46
        Range("BK46:BM46" ).Select
        Selection.Copy
        Windows("Anmois.xls" ).Activate  ' on va sur l'XL central Col E ligne Lig46
        Range("E" & Lig).Select
        ActiveSheet.Paste
 
        Windows(Fichxl).Activate        ' on va copier la lig.47
        Range("BK47:BM47" ).Select
        Selection.Copy
        Windows("Anmois.xls" ).Activate  ' on va sur l'XL central Col H ligne Lig47
        Range("H" & Lig).Select
        ActiveSheet.Paste
         
        Windows(Fichxl).Activate        ' on va copier la lig.48
        Range("BK48:BM48" ).Select
        Selection.Copy
        Windows("Anmois.xls" ).Activate  ' on va sur l'XL central Col H ligne Lig48
        Range("K" & Lig).Select
        ActiveSheet.Paste
         
        Windows(Fichxl).Activate        ' on revient sur le fcihier lu
        Application.DisplayAlerts = False
        ActiveWorkbook.Close            ' pour le fermer
        Application.DisplayAlerts = True
        Fichxl = Dir                    ' nom Fichier suivant
    Loop
    Next M
    ' Sauvegarde du tableau chaque fin de dossier mois
    ' Remplacer le chemin "C:\Documents and Settings\Anmois.xls" par le bon.
    ActiveWorkbook.SaveAs Filename:="E:\CD\Bilans_Journaliers_Choisy\Anmois.xls", _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
Next X
' en pas à pas, on peut passer de la macro à la feuille et suivre le travail
' Quand tout va bien, F5 exécute sans pas à pas...
' Macro1 Macro
'
 
'
End Sub
ciao

Reply

Marsh Posté le 11-05-2006 à 12:52:27    

Merci beaucoup!!
 
pour le copier/coller en valeur je ne sais pas...encore! je trifouille un petit peu et je te reviens!!
 
fix

Reply

Marsh Posté le 11-05-2006 à 15:16:18    

Bonjour Pierre , fix50
Bonjour à tous
 
Juste une petite aide :
 
Sub Macro1()
    Selection.Copy      ''' copie tout de la cellule soit valeur,formule ,et format
    Range("D5" ).Select  ''' va dans d5
    ActiveSheet.Paste   ''' colle tout de la première cellule : soit formule (mais pas le résultat)
                        ''' ou la valeur, le text, ...
    Range("D9" ).Select  ''' va dans d9
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False     ''' ne copie que la valeur
End Sub
 
Bon courage
 
Cordialement

Reply

Marsh Posté le 13-05-2006 à 15:58:21    

merci eric, grace a toi j'ai pu faire tourner ma macro
c'est bien utile ce genre de bricolage sous excel, faudrait que je m'y mettes sérieusement un de ces 4 ...
Bon WE

Reply

Marsh Posté le 14-05-2006 à 03:13:25    

A priori on peut "optimiser" manuellement par exemple :
           
        Windows(Fichxl).Activate        ' on va copier la lig.47  
        Range("BK47:BM47" ).Select  
        Selection.Copy  
        Windows("Anmois.xls" ).Activate  ' on va sur l'XL central Col H ligne Lig47  
        Range("H" & Lig).Select  
        ActiveSheet.Paste  
 
devient
 
        Windows(Fichxl).Activate        ' on va copier la lig.47  
        Range("BK47:BM47" ).Copy  
        Windows("Anmois.xls" ).Activate  ' on va sur l'XL central Col H ligne Lig47  
        Range("H" & Lig).PasteSpecial xlPasteValues
 
voire  
 
       Range("BK47:BM47" ).Copy ShAnMois.Range("H" & Lig)


Message édité par kiki29 le 15-05-2006 à 10:24:05
Reply

Marsh Posté le 16-05-2006 à 08:01:29    

Voir http://forum.hardware.fr/hardwaref [...] 0232-1.htm
qui adapté, devrait booster les performances de lecture de tes fichiers d'un facteur 100


Message édité par kiki29 le 16-05-2006 à 08:03:43
Reply

Sujets relatifs:

Leave a Replay

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