Discussion :

[albibak]

Bonjour,

Tout d'abord, je ne sais pas du tout faire de macro Excel. Voilà, le décor est planté.

Sinon, je cherche, pour mon boulot, à faire la chose suivante:

J'ai un repertoire que l'on nommera : "Bilan", lequel contient X fichiers Excel, ayant le même contenu (je parle niveau colonne, pas le contenu des cellules). Chaque fichier Excel a un nom différent, mais commençant toujours de la même façon "bilan_xxxxx"
Ces fichiers Excel ont des données uniquement sur la première feuille.

Je cherche, via une macro (car le nombre de fichier est important), à copier la feuille 1 de chaque fichier dans un fichier unique.
A savoir que la copie de la feuille 1 du classeur 1 ne doit biens ur pas être effacer par la feuille 1 du classeur 2.
Tout doit se retrouver les uns en dessous des autres.

Par avance merci pour votre aide.

[rvtoulon]

Slt,
peut-être un début de réponse ici :http://www.developpez.net/forums/d85...seul-classeur/

A+

[albibak]

Oui cela à l'air de correspondre à ce que je veux faire.

Reste à comprendre ces lignes là

Code :

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

1
2
3
4
 
       Ligne = .Range("A65536").End(xlUp).Row + 1
        Set wbk = Workbooks.Open("C:\classeurs\" & Fich)
        wbk.Sheets("Feuil1").Range("A7", wbk.Sheets("Feuil1").Range("H65536").End(xlUp)).Copy .Cells(Ligne, 1) 'wbk.Sheets("Feuil1") à adapter en fonction du nom de la feuille à copier

[rvtoulon]

slt,
j'ai remis le code de mercatog du lien que je t'avais donné avec quelques explications

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
Sub test()
Dim wbk As Workbook, awbk As Workbook
Dim wsh As Worksheet
Dim Fich As String
Dim Ligne As Double
 
Application.ScreenUpdating = False
'définie le classeur de destination, le classeur d'ou la macro est lancée
Set awbk = ThisWorkbook
'définie la feuille de destination
Set wsh = awbk.Sheets(1)
 
'définie le répertoire ou se trouve les fichiers à copier
Fich = Dir("C:\Bilan\*.xls")
'dans chaque fichier
Do While Fich <> ""
    With wsh
        'définie a partir de la colonne A la dernière ligne vide
        Ligne = .Range("A65536").End(xlUp).Row + 1
 
        'définie et ouvre le fichier source
        Set wbk = Workbooks.Open("C:\Bilan\" & Fich)
        'copie une plage de cellule ici "A7:H" & dernière ligne pleine de la colonne H
        'dans la feuille de destination à la première ligne vide à partir de la colonne A
        'TU DEVRAS ADAPTER LA PLAGE A TES BESOINS ici : (range ("A7", wbk.etc...)
        wbk.Sheets("Feuil1").Range("A7", wbk.Sheets("Feuil1").Range("H65536").End(xlUp)).Copy .Cells(Ligne, 1)
    End With
    'ferme le classeur source
    wbk.Close False
    Fich = Dir
    'remet à zéro la variable qui ouvre le fichier source
    Set wbk = Nothing
Loop
Set wsh = Nothing
Set awbk = Nothing
Application.ScreenUpdating = True
End Sub

si tu as des questions :
A+

[albibak]

Lorsque je teste, j'ai ce message d'erreur: "L'indice n'appartient pas à la sélection", puis m'ouvre un des fichiers Excel que je souihaite copier.

A savoir également que certaines cellules de mes fichiers Excel à copier, sont vides, et que je dois les copier tout de même.

Mes colonnes vont de A à Q

[rvtoulon]

re,
1) lorsque tu es dans l'éditeur appuie sur F8 pour lancer la macro pas à pas. tu appuie plusieurs fois sur cette touche jusqu'a la ligne qui génère cette erreur et tu nous l'a montre, stp, car difficile de deviner le problème.

2) Dans tes fichiers doit-on copier à partir de A1?


EDIT: j'ai fait quelques changements dans le code :

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
Sub test()
Dim wbk As Workbook, awbk As Workbook
Dim wsh As Worksheet
Dim Fich As String
Dim Ligne As Long, derlign As Long
 
Application.ScreenUpdating = False
'définie le classeur de destination, le classeur d'ou la macro est lancée
Set awbk = ThisWorkbook
'définie la feuille de destination
Set wsh = awbk.Sheets(1)
 
'définie le répertoire ou se trouve les fichiers à copier
Fich = Dir("C:\Documents and Settings\Atelier\Bureau\Bilan\*.xls")
'dans chaque fichier
Do While Fich <> ""
    With wsh
        'définie a partir de la colonne A la dernière ligne vide
        Ligne = .Range("A65536").End(xlUp).Row + 1
 
        'définie et ouvre le fichier source
        Set wbk = Workbooks.Open("C:\Documents and Settings\Atelier\Bureau\Bilan\" & Fich)
        derlign = wbk.Sheets(1).Cells.Find("*", , , , , xlPrevious).Row
        'copie une plage de cellule ici "A1:Q" 
        'dans la feuille de destination à la première ligne vide à partir de la colonne A
        wbk.Sheets(1).Range("A1:Q" & derlign).Copy .Cells(Ligne, 1)
    End With
    'ferme le classeur source
    wbk.Close False
    Fich = Dir
    'remet à zéro la variable qui ouvre le fichier source
    Set wbk = Nothing
Loop
Set wsh = Nothing
Set awbk = Nothing
Application.ScreenUpdating = True
End Sub

Si j'ai vu juste le probleme viens du nom des tes feuils, dans le code j'ai remplacer "sheets ("feuil1")" par le num de la feuille "sheets (1)" . J'ai ensuite adapter le code à ta plage A:Q. Dis moi ce qu'il en est...
A+

[YANN-56]

Bonsoir Albibak, et rvtoulon (Au passage bon souvenir de La Crau),
et à eux qui passeront par là.

Albibak, si tu ne sais pas faire de Macros; j'ose penser qu'ici tu vas bien apprendre.

De mon coté, je ne suis pas un pro, mais j'ai des p'tits trucs qui me servent bien.

Notamment l'utilisation des ListView, et d'enregistrer dans les propriétés de mon
Classeur dans le chemin des recherches qui le concernent.

Tu regardes, et tu me dis. Je suis disposé à commenter...
Attention au nom de la feuille du classeur que tu veux copier: Ici; c'est "Feuil1"

Je joins un exemple en espérant qu'il passe...

Bonne fin de journée à toi et à tous.

Yann

[albibak]

re,
1) lorsque tu es dans l'éditeur appuie sur F8 pour lancer la macro pas à pas. tu appuie plusieurs fois sur cette touche jusqu'a la ligne qui génère cette erreur et tu nous l'a montre, stp, car difficile de deviner le problème.

2) Dans tes fichiers doit-on copier à partir de A1?


EDIT: j'ai fait quelques changements dans le code :

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
Sub test()
Dim wbk As Workbook, awbk As Workbook
Dim wsh As Worksheet
Dim Fich As String
Dim Ligne As Long, derlign As Long
 
Application.ScreenUpdating = False
'définie le classeur de destination, le classeur d'ou la macro est lancée
Set awbk = ThisWorkbook
'définie la feuille de destination
Set wsh = awbk.Sheets(1)
 
'définie le répertoire ou se trouve les fichiers à copier
Fich = Dir("C:\Documents and Settings\Atelier\Bureau\Bilan\*.xls")
'dans chaque fichier
Do While Fich <> ""
    With wsh
        'définie a partir de la colonne A la dernière ligne vide
        Ligne = .Range("A65536").End(xlUp).Row + 1
 
        'définie et ouvre le fichier source
        Set wbk = Workbooks.Open("C:\Documents and Settings\Atelier\Bureau\Bilan\" & Fich)
        derlign = wbk.Sheets(1).Cells.Find("*", , , , , xlPrevious).Row
        'copie une plage de cellule ici "A1:Q" 
        'dans la feuille de destination à la première ligne vide à partir de la colonne A
        wbk.Sheets(1).Range("A1:Q" & derlign).Copy .Cells(Ligne, 1)
    End With
    'ferme le classeur source
    wbk.Close False
    Fich = Dir
    'remet à zéro la variable qui ouvre le fichier source
    Set wbk = Nothing
Loop
Set wsh = Nothing
Set awbk = Nothing
Application.ScreenUpdating = True
End Sub

Si j'ai vu juste le probleme viens du nom des tes feuils, dans le code j'ai remplacer "sheets ("feuil1")" par le num de la feuille "sheets (1)" . J'ai ensuite adapter le code à ta plage A:Q. Dis moi ce qu'il en est...
A+

Alors je viens de tester, mais il me copie toujours la première feuille des autres classeurs, or je veux copier la seconde, mais même quand je change le nombre de sheet(x), ca me copie toujours la première.

Sinon, j'ai remarqué que ca ne me copiait le contenu que d'un seul des fichiers, et non tous les fichiers les uns à la suite des autres.

[albibak]

Bonsoir Albibak, et rvtoulon (Au passage bon souvenir de La Crau),
et à eux qui passeront par là.

Albibak, si tu ne sais pas faire de Macros; j'ose penser qu'ici tu vas bien apprendre.

De mon coté, je ne suis pas un pro, mais j'ai des p'tits trucs qui me servent bien.

Notamment l'utilisation des ListView, et d'enregistrer dans les propriétés de mon
Classeur dans le chemin des recherches qui le concernent.

Tu regardes, et tu me dis. Je suis disposé à commenter...
Attention au nom de la feuille du classeur que tu veux copier: Ici; c'est "Feuil1"

Je joins un exemple en espérant qu'il passe...

Bonne fin de journée à toi et à tous.

Yann

Merci Yann pour ton aide.

En mode de bug, j'ai une erreur ici:

"Impossible d'ouvrir le fichier"

ActiveWorkbook.FollowHyperlink ActiveWorkbook.Subject _
& UserForm1.ListView1.ListItems(i).Text & ".xls"

[rvtoulon]

bjr, plusieurs remarques :
1)

Alors je viens de tester, mais il me copie toujours la première feuille des autres classeurs, or je veux copier la seconde, mais même quand je change le nombre de sheet(x), ca me copie toujours la première.

Ben oui, dans ton premier message tu dis:

Je cherche, via une macro (car le nombre de fichier est important), à copier la feuille 1 de chaque fichier dans un fichier unique.

si tu met "sheets (2)" ici

Code :

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

derlign = wbk.Sheets(2).Cells.Find("*", , , , , xlPrevious).Row

, et là

Code :

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

wbk.Sheets(2).Range("A1:Q" & derlign).Copy .Cells(Ligne, 1)

la macro copiera la deuxième feuille. Sinon remplace "Sheets (2)" par Sheets("NOMDELAFEUILLEACOPIER"), en espérant que dans chaque classeur elle porte le même nom sinon tu auras l'erreur que tu as précédemment décrite.

2) tu dis aussi:

Sinon, j'ai remarqué que ca ne me copiait le contenu que d'un seul des fichiers, et non tous les fichiers les uns à la suite des autres.

Je viens de tester la macro en mettant des fichiers excel dans un répertoire nommé bilan et elle me copie la deuxième feuille de chaque classeur à la suite des autres dans la feuille 1 du classeur unique.
As-tu changer quelques choses à la macro? Peux-tu mettre le code que tu utilises dans ton classeur.
Merci à +

[YANN-56]

Bonjour

La raison est que dans les options des dossiers, tu n'as pas coché
"Masquer les extensions dont le type est connu".

Donc, dans ce cas; il faut supprimer dans cette ligne: & ".xls"

Bonne journée.

Yann

[albibak]

bjr, plusieurs remarques :
1)
Ben oui, dans ton premier message tu dis: si tu met "sheets (2)" ici

Code :

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

derlign = wbk.Sheets(2).Cells.Find("*", , , , , xlPrevious).Row

, et là

Code :

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

wbk.Sheets(2).Range("A1:Q" & derlign).Copy .Cells(Ligne, 1)

la macro copiera la deuxième feuille. Sinon remplace "Sheets (2)" par Sheets("NOMDELAFEUILLEACOPIER"), en espérant que dans chaque classeur elle porte le même nom sinon tu auras l'erreur que tu as précédemment décrite.

2) tu dis aussi:
Je viens de tester la macro en mettant des fichiers excel dans un répertoire nommé bilan et elle me copie la deuxième feuille de chaque classeur à la suite des autres dans la feuille 1 du classeur unique.
As-tu changer quelques choses à la macro? Peux-tu mettre le code que tu utilises dans ton classeur.
Merci à +

Super, ça marche impec, merci.
J'ai modifié 2-3 trucs pour ça corresponde mieux à mon besoin.

Ca met bien tout à la suite et tous les classeurs.

Il me reste à voir comment faire pour ne pas réinscrire une ligne si le contenu d'une celulle est déjà présente dans un fichier.
Je m'explique, il y a une cellule incident par exemple, qui contient des numéros d'incident.
Si dans le prochain fichier que j'ouvre, le numero d'incident est déjà présent dans le fichier que je viens de créer, alors il ne recopie pas la ligne.