Xls 2007- extraction d'information

bonjour tout le monde,

j'ai un petit problème avec des macro copier ici et la ... "y a des idées mais pas le savoir" lol !

p'tit 1:

Sub GetSheets()
' scripts VBA pour regrouper des classeurs multiples en un seul classeur principal, qui ce trouve dans le meme dossier.
'Ce code VBA fusionne les classeurs entiers dans le classeur principal; si vous voulez regrouper des feuilles de calcul spécifiques des classeurs, ce code ne fonctionnera pas.
'
Path = "C:\Users\excel-pratique\Desktop\test_analyse\"
Filename = Dir(Path & "*.xls")    ' si je rajoute ===> Dir(Path & "*.xls" & "*.xlsx" & "*.xlsm") ça fonctionnerai ?
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     Sheet.Copy After:=ThisWorkbook.Sheets(1)
  Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
End Sub

j'ai un message en fin de la récupération des classeurs qui dit " RECUP_donner.xlsm est deja ouvert.

si vous l'ouvrez à nouveau , tout vos modification seront perdues. voulez vous rouvrir RECUP_donner.xlsm ?" .

le tout suivit par une fenêtre VBA "erreur d'exécution 1004 : la méthode 'Open' de l'objet 'workbooks' a échoué" .

si je fait Débogage il montre la ligne suivante "Workbooks.Open Filename:=Path & Filename, ReadOnly:=True"

p'tit 2:

j'aimerais listé les onglets et en même temps récupéré le contenue de certaine cellules. je voulais faire une bidouille mais nada

code 1

Sub Snamelist() 'liste tout les onglets sans exception nickel pour moi 
Dim i As Integer

    Range("a5").Select ' ici départ du tableau

    For i = 1 To Sheets.Count
        ActiveCell.Value = Sheets(i).Name
        ActiveCell.Offset(1).Select

    Next i

End Sub

code 2

Sub ListeRecap() '<=== ne totalise pas tout les onglets que celle avec un nom numérique , mais liste les cellules qui m’intéresse :D 
Dim F As Worksheet
Dim Dest As Range

Set Dest = ActiveSheet.Range("A5") ' ici départ du tableau

Dest.CurrentRegion.Offset(1).ClearContents

For Each F In Worksheets

  If IsNumeric(F.Name) Then ' je pense que mon problème ce trouve la ...
    Dest = F.Name
    Dest.Offset(, 1) = F.Range("b6")
    Dest.Offset(, 2) = F.Range("d6")
    Dest.Offset(, 3) = F.Range("b9")
    Dest.Offset(, 4) = F.Range("d9")
    Set Dest = Dest.Offset(1)
  End If
Next F

Set Dest = Nothing

End Sub

P'tit 3:

j'aimerai une redirection par nom d'onglet ...

l'idée serai :

_ rassembler tout les classeurs d'un dossier sur un seul classeur ( ça OK) , Ok mais je rencontre un problème en fin d'action du code

_ il me faut faire, une liste de tout les onglets (ça ok) et en extraire des informations (ça fonctionne a 50%).

_ j'aimerais que le nom de l'onglet pointe voir ce dernier (plus rapide a retrouver) .

si possible en un seul code pour les deux derniers

plus tard ... j'aimerais via un autre classeur regrouper toute les infos de la même manière .

une analyse mensuel ==> des analyses bi-mensuel et une analyse en fin d'année

voila si solution vous avez , je me ferai un plaisir de les acceptés

merci

Bonsoir,

Une petite chose à la fois (sinon je comprendrais plus rien au film que je regarde ) :

Si le classeur en question est celui avec lequel tu opères, et qu'il se trouve dans le même dossier que les autres, il faut évidemment l'exclure de ton opération !

Cordialement.

MFerrand a écrit :

Bonsoir,

Une petite chose à la fois (sinon je comprendrais plus rien au film que je regarde ) :

Si le classeur en question est celui avec lequel tu opères, et qu'il se trouve dans le même dossier que les autres, il faut évidemment l'exclure de ton opération !

Cordialement.

salut Mferrand,

je pense comprendre... si dans le dossier il y a 50 classeurs a analysé + 1 classeur (déjà ouvert ) pour récolté les informations, le script vba lui va scanner les 51 classeurs... comment l'exclure ?

je ne sais pas si l'info vous aidez mais,

dans mon dossier 2017, il y a déjà + 80 dossiers , chaque dossier a environ entre 0 et 20 classeurs de même type. dans le dossier 2017 il y a des classeurs en attente de classement dans l'un des 80 sous dossier.

Bonjour,

Ta macro cherche, pour autant que j'ai bien lu, des fichier Excel dans un seul dossier, lequel ne se trouve pas dans un dosier '2017'... A tes dires du message d'erreur, la question se pose de savoir si le classeur 'maître', soit celui avec lequel tu opères, se trouve dans ce dossier.

Il serait bon qu'au lieu de répondre en citant sytématiquement, tu confirmes ou infirmes !

Si c'est le cas, il faut l'exclure, ce qui peut être rapidement fait en fin de boucle, après Filename = Dir() :

        Filename = Dir()
        If Filename = "RECUP_donner.xlsm" Then Filename = Dir()
    Loop

Cordialement.

salut Mferrand, avant tout merci de ton aide !

après pour dire si je confirme ou pas , je te CONFIRME que j'ai mis en ligne un ZIP pour EXEMPLE .

le dossier analyse, ce retrouvera dans un autre dossier.

exemple :

recup_donner.xlsm, Classeur 1, Classeur 2, Classeur 3 ==dans=> dossier analyse 1

recup_donner.xlsm, Classeur 1, Classeur 2, Classeur 3 ==dans=> dossier analyse 2

recup_donner.xlsm, Classeur 1, Classeur 2, Classeur 3 ==dans=> dossier analyse 3

âpres:

dossier analyse 1, dossier analyse 2, dossier analyse 3 ==dans => Dossier analyse globale <

Plus tard je devrais faire l'analyse des fichiers RECUP_DONNER ce trouvent dans les dossiers Analyses XXX , ... seront aussi analysé de la même sorte sauf que le classeur ne sera pas dans le même dossier mais une racine plus haute

en PJ un screen du bug même avec ta modif.

désoler si je ne suis pas assez claire pour toi .

cordiaklement

Bonjour,

Si on restait centré sur le sujet, soit l'erreur indiquée ! On pourra toujours digresser ensuite...

Tu sembles confirmer indirectement que ton classeur est bien dans le même dossier, mais tu ne confirmes pas le nom du classeur alors dans le doute, mets ceci :

        Filename = Dir()
        If Filename = ThisWorkbook.Name Then Filename = Dir()
    Loop

Cordialement.

T'AI un CHEF !!!! premier problème OK

je viens juste de comprendre que quand tu dit

"Tu sembles confirmer indirectement"

tu parle de la macro , désoler

correction du premier code

    Sub GetSheets()
    ' scripts VBA pour regrouper des classeurs multiples en un seul classeur principal, qui ce trouve dans le meme dossier.
    'Ce code VBA fusionne les classeurs entiers dans le classeur principal; si vous voulez regrouper des feuilles de calcul spécifiques des classeurs, ce code ne fonctionnera pas.
    '
    Path = "C:\Users\excel-pratique\Desktop\test_analyse\"
    Filename = Dir(Path & "*.xls")    ' si je rajoute ===> Dir(Path & "*.xls" & "*.xlsx" & "*.xlsm") ça fonctionnerai ?
     Do While Filename <> ""
      Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
         For Each Sheet In ActiveWorkbook.Sheets
         Sheet.Copy After:=ThisWorkbook.Sheets(1)
      Next Sheet
         Workbooks(Filename).Close

' MFerrand a la bonne solution
     Filename = Dir()
        If Filename = ThisWorkbook.Name Then Filename = Dir()
    Loop
    End Sub

plus de problème pour l'import

up

personne a d'idée sur mon probleme ?