Discussion :

[NulenExcel77]

Bonjour à toutes et à tous,

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 .

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
'------------------------------------------------------------------------------
' 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.

Cordialement

[Kimy_Ire]

Même si tu as tenté de bien expliquer ton problème, pourrais-tu nous donner un fichier exmple ou d'avantages d'explications dans lequels tu spécifierais de manière explicite ce que tu veux importer de tes différents classeurs dans ta feuille "Récap".

Ce sont des colonnes que tu veux déplacer, des cellules particulières ? Ce sont des feuilles complètes, certaines feuilles de certains classeurs ? Où se situent les autres classeurs, sur un serveur, dans le même répertoire que ton classeur où tu as ta feuille "Récap"? etc...

En tout cas ces précisions m'aideraient, moi, à t'aider dans ta requète !

[NulenExcel77]

Bonjour Kimy Ire,

Désolé pour le manque de renseignements, la tète dans la sauce je comprends ce que
j'écris mais,j'ai pas pensé à vous, lol. Et merci de t'interresser à mon cas.


Les bases:
Tous mes fichiers cibles sont dipersés par famille (sous dossiers donc) et l'ensemble dans
un dossier maitre.


Ce que je voudrais faire avec votre aide:
Recuperer les valeurs (format possible: nombre standard, date, heure) en b3, c3, d3, e3
de tous les fichiers et dans tous les sous-dossiers (structurés de la même façon)
pour les copier à la suite dans un fichier de commande disons en b3, c3, d3, e3
par exemple.


Pour le cas ,me connaissant, ou je n'aurais pas été assez clair, voici en Pj un ensemble
de classeurs afin de mieux visualiser.

Alors pour repondre clairement(j'espere) à tes interrogations, oui les fichiers cibles sont sur un
reseau, il n'y a q'une feuille par classeur mais ce n'est pas forcement la N°1 (une feuille est resté
les autres ont étés supprimés, désolé pour le bordel ) la fiche Recap sur un poste seulement

Si ce n'est pas trop te demander, serait il possible d'inclure une condition en début de macro,
du genre si la feuille cible a pour nom "rebus.xls" de ne pas l'ouvrir.



Merci encore

[Kimy_Ire]

Aujourd'hui j'ai progressé en VBA ! ^^

Ton problème m'a intéressé donc, j'ai un peu codé !

Je te propose le code suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Sub MoveData()
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
 
With Worksheets("Feuil1")
    Set cell_des = .Columns(2).Find("*", , , , xlByColumns, xlPrevious).Offset(1, 0)
 
 
    Set Dossier = CreateObject("Scripting.FileSystemObject")
    Set chem_doss = Dossier.GetFolder("C:\Users\...\Desktop\Dossier maitre")
    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("Feuil1")
                Set cell_ori = .Range("B1")
                For i = 0 To .Columns(2).Find("*", , , , xlByColumns, xlPrevious).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

ALORS... il y a des conditions !
Tout d'abord, il faut que tu remplaces le chemin suivant "C:\Users\...\Desktop\Dossier maitre" par le tien.
Ensuite, les conditions sont les suivantes :
- Il faut que toutes les feuilles desquelles tu veux tirer les informations (celles qui sont dans les "Sous-dossier") aient leurs données stockées dans le même nom d'onglet (ici = "Feuil1" => With Workbooks(workb.Name).Worksheets("Feuil1") )
- Il faut que tu actives ta macro depuis ton classeur "Récap" depuis la feuille "Feuil1" (=> With Worksheets("Feuil1") )
- Je déplace uniquement 4 colonnes (=> For j = 0 To 3)

Bref, tout ça est modifiable ! Dis moi si ça te convient !

Petit problème, les données déplacées ne sont pas sous le forme d'origine. J'entends par là que 05/12/2012 deviendra 41248.
Il y a la possibilité de caster les différentes colonnes, mais je te laisse le faire si tu le souhaites vraiment.
La finalité, tu auras juste à cliquer les colonnes qui ne sont pas au bon format et à les caster en date ou en heures !

EDIT :
- les données s'ajoutent à la suite du tableau dans la feuille "Récap" en testant la colonne 2 (=> Set cell_des = .Columns(2).Find("*", , , , xlByColumns, xlPrevious).Offset(1, 0) )
- le programme test la colonne B des fichiers placés dans les sous-dossiers (=> Set cell_ori = .Range("B1") )

[NulenExcel77]

Bonjour Kimy_Ire,

Je vais de ce pas essayer ta macro, qui disons le, a de la gueule ,
En plus je suis au boulot avec mon vieil excel 2000, si ça marche ici, ça marchera partout, lol.

P'tite question au passage, je me trompe peut être , mais ne pourrais pas mettre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With Workbooks(workb.Name).Worksheets(1)

pour les feuilles cible pour ainsi ne prendre en compte que la seule et unique feuille excel du classeur ?? au lieu de "feuil1".

Qu'en penses tu??

[Kimy_Ire]

Si c'est la première feuille de chaque classeur dans ce cas, oui, bien entendu ! Pour autant, je n'utilise jamais cela car déplacer une worksheet est assez facile (même par inadvertance). Donc je préfère l'utilisation du nom des worksheets ! Mais libre à toi : c'est ton programme ! =)