execl 2003 - Adaptation macro pour dossier et sous-dossier

Question

Bonjour à toutes et à tous,

Je ne suis pas sur d'etre au bon endroit (1er fois)veuillez m'excuser par avance

J'ai besoin pour mon travail de faire une synthèse avec une feuille excel "Récap"
et d'y copier plusieurs données provenant de plusieurs classeurs dans différents dossiers et sous dossiers.

J'ai cherché dans ce forum sans trouver (ou sans comprendre)  ce que je voulais exactement. Quelques bout de code par ci par là, mais comme mon pseudo l'indique, j'ai du mal à fusionner tous ça.

Je précise que je travail sur une version d'excel 2003 voir 2000 sur certain poste, et je ne sais pas comment assurer la compatibilité entre les version d'excel.

Voici ce qui ce rapproche le plus de mon but, il faudrait l'adapter pour inclure les sous dossier. Je l'ai trouvé sur le net .


'------------------------------------------------------------------------------
' Macro qui permet de compiler les informations contenues dans
' différents fichier pour les regrouper dans un fichier récapitulatif
' Sélection d'un répertoire contenant les fichiers
' GCXL
'-------------------------------------------------------------------------------
Sub Creer_Recapitulatif_2()
    Dim sRep As String              'Répertoire ou filtre
    Dim sFichier As String
 
    Application.ScreenUpdating = False
    sRep = ChoisirRepertoire & ""      'Boîte de dialogue pour choisir répertoire
 
    sFichier = Dir(sRep)
    Do While sFichier <> ""
        Workbooks.Open sRep & sFichier   'ouvrir le fichier
 
        ' Ici on récupère la valeur de la cellule A1 du fichier
        ThisWorkbook.Sheets(1).Range("A65000").End(xlUp).Offset(1, 0) = ActiveWorkbook.Sheets(1).Range("A1")
        ActiveWorkbook.Close savechanges:=True
 
        sFichier = Dir   'trouve le prochain fichier
    Loop
    Application.ScreenUpdating = True
End Sub
 
Function ChoisirRepertoire() As String
    Dim diaFolder As FileDialog
 
    ' Open the file dialog
    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    diaFolder.AllowMultiSelect = False
    diaFolder.Show
 
    ChoisirRepertoire = diaFolder.SelectedItems(1)
 
    Set diaFolder = Nothing
End Function

Merci d'avance pour votre aide précieuse qui j'en suis sur me fera évoluer.

Il m'arrive trés souvent de manquer de clarté dans mes explications, n'hesitez pas à m'en faire part et à me demander plus d'elements.

Cordialement

cs_Jack · Answer

Salut et bienvenu(e)

Clarté, ça va. C'est la question qui manque.
Quelle est ta difficulté ?
D'après un survol de ton code (*), ça doit marchouiller, non ?
Que lui reproches-tu ?

(*) Quand tu colles du code, utilise la coloration syntaxique (3ème icone à droite) = Plus lisible et conserve les indentations (espaces en tête de ligne)

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

NewinExcel77 · Answer

Bonjour Jack,

Merci de t'interrsser à ma requete.
Oui oui la macro ci dessus machouille molto bien (lol), ma question est de savoir si on pourrais l'adapter. 

Le probleme N°1 est que je suis obligé de faire avec mes neuneurones, je suis débutant en Excel et je ne sais pas adapter en vba une macro fonctionnelle.

En effet cette macro ne marche que pour un dossier cible seulement et non avec ses sous-dossier et sous-sous-dossier etc ... Il faudrait que la macro visualise tous les classeurs.

Ps:Merci pour l'info du code à coller ,je m'en souviendrais.

@+

ucfoutu · Answer

Bonjour,
Tu sais que ce forum dispose d'un moteur de recherche à utiliser sans crainte ?
Va donc voir le code que j'ai mis dans mon message du 22 avril dernier dans cette discussion :
Tapez le texte de l'url ici.
Tu aurais gagné beaucoup de temps en utilisant le moteur de recherche (que je viens d'ailleurs d'utiliser moi-même pour retrouver mon propre code) 


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

NewinExcel77 · Answer

Bonjour à toi ucfoutu,

Oui je sais bien  c'est comme ça que j'ai trouvé cette macro qui se rapproche le plus de ce que je souhaite.

J'ai aussi vu des macro listant tous les fichiers contenu dans un répertoire et sous-répertoire, mais mon problème est de fusionner les deux, comme je l'ai dis, je suis plutôt débutant en vba.

J'avais l'idée (non réalisé) de faire en sorte que la macro de "récup de données" utilise les adresses d'un onglet caché ou était listés tous les fichiers excel, mais ça m'a l'air interminable comme processus (en exécution excel), non  

C'est pour cela que je sollicite votre aide à tous.

Bien cordialement

NewinExcel77 · Answer

Bonjour,

J'abandonne pour le moment, je clos cette discussion.

Je repasserai par chez vous si j'ai du nouveau.

@+

cs_MPi · Answer

Avant de clore, regarde du côté de fonction récursive.
En cherchant, tu trouveras bien un exemple facile à comprendre...


MPi²
Pour ceux qui programment sous Office, n'oubliez pas qu'il existe un forum dédié à ces applications VBA....... ICI

ucfoutu · Answer

Bonjour, MPI,
regarde du côté de fonction récursive

Pardi. Mais c'est le code que j'ai écrit dans le lien que je lui ai demandé de lire. Et il a répondu (je n'ai pas compris sa réponse) :
J'ai aussi vu des macro listant tous les fichiers contenu dans un répertoire et sous-répertoire, mais mon problème est de fusionner les deux
Je préfère ne pas chercher à comprendre ce qu'il a voulu exprimer 
________________________
Réponse exacte ? => "REPONSE ACCEPTEE" facilitera les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement répéter son contenu. Je n'interviendrai que si nécessité de la compléter.

NewinExcel77 · Answer

Bonjour MPi & ucfoutu,

Désolé si j'ai pas pu répondre assez vite.

Voilà, j'ai plus ou moins trouvé avec l'aide d'internautes( merci à  Kimy_Ire entre autres) une solution à mon problème même si la moulinette est un peu longuette (pour une centaine de fichiers à gérer)

Je vous le donne si vous avez des critiques à me donner.

Option Explicit
Public Sub MoveData2()
Dim Dossier, chem_doss, sDossier, fles, name_f, workb
'Dim Wk As Workbook
Dim cell_ori As Range
Dim cell_des As Range
'Dim cpy As Range
Dim i As Integer
Dim j As Integer
 
With Worksheets("Final")
    'Set cell_des = .Columns(2).Find("*", , , , xlByColumns, xlPrevious).Offset(1, 0) 'ne marche pas avec cette synthaxe sur XL2000
    Set cell_des = Range("B" & Rows.Count).End(xlUp).Offset(1, 0)
 
 
    Set Dossier = CreateObject("Scripting.FileSystemObject")
 '   Set chem_doss = Dossier.GetFolder("C:\Documents and Settings\???\Bureau\Recap\Fiche suivi")
     Set chem_doss = Dossier.GetFolder("G:\Fiches Suiveuses\?????")
    Set sDossier = chem_doss.SubFolders
    For Each fles In sDossier
        Set name_f = fles.Files
        For Each workb In name_f
 
            On Error Resume Next
            Workbooks.Open workb
 
            With Workbooks(workb.Name).Worksheets(1)
                Set cell_ori = .Range("G7")
                For i = 0 To .Range("B" & Rows.Count).End(xlUp).Row - 1
                    If cell_ori.Offset(i, 0) <> "" Then
                        For j = 0 To 3
                            cell_des.Offset(0, j) = cell_ori.Offset(i, j)
                        Next j
 
                        Set cell_des = cell_des.Offset(1, 0)
                    End If
 
 
                Next i
            End With
 
 
 
'            s = s & workb.Name
'            s = s & vbCrLf
 
            Workbooks(workb.Name).Close
        Next
    Next
'    MsgBox s
 
End With
 
End Sub

Mpi, merci pour l'info, je me penche du coté des fonctions récursives et essaie de trouver une alternative à cette macro.

Je vous tiens au courant.

@ bientôt

Execl 2003 - Adaptation macro pour dossier et sous-dossier

8 réponses

Votre réponse

Discussions similaires