Regrouper des fichiers Excel en un seul

Version imprimable

Bonjour,

J'ai à ma disposition 304 fichiers Excel nommés Contact(1), Contact(2), ...Contact(304)

Chaque fichier contient un seul onglet portant le même nom que le fichier.
Je souhaite récupérer le contenu des cellules allant de A2 à I51 de chaque fichier et les regrouper en un seul fichier.

Voici après plusieurs recherches le code que j'ai essayer d'utiliser, en l'adaptant à mon besoin bien sûr :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Sub test3() Dim Fich As String, Ligne As Double Fich = Dir("C:\Contacts\*.xls") Do While Fich <> "" Ligne = Range("a51").End(xlUp).Row + 1 Workbooks.Open "C:\Contacts\" & Fich Range("A2", Range("I51").End(xlUp)).Copy _ ThisWorkbook.Sheets(1).Cells(Ligne, 1) ActiveWorkbook.Close False Fich = Dir Loop End Sub
Le nombre total de lignes dans mon fichier final est inférieur à ce que je devrais obtenir.

Merci d'avance à toute personne pouvant me venir en aide, soit en voyant d'où vient l'erreur, soit en me guidant vers une autre piste.

Pierre

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub test3()
Dim Wbk As Workbook
Dim Fich As String
Dim j As Long
 
Fich = Dir("C:\Contacts\*.xls")
Application.ScreenUpdating = False
Do While Fich <> ""
    Set Wbk = Workbooks.Open("C:\Contacts\" & Fich)
    ThisWorkbook.Sheets("Feuil1").Range("A" & 2 + j & "I" & 51 + j).Value = Wbk.Sheets(1).Range("A2:I51").Value    'Adapte le nom Feuil1 à ta feuille destination
    j = j + 50
    Wbk.Close
    Set Wbk = Nothing
    Fich = Dir
Loop
End Sub

11/10/2010, 18h26
piercleo

Bonjour Mercatog et merci de ta réponse,

Quand je lance la macro j'obtiens l'erreur 1004 (erreur définie par l'application ou par l'objet) sur la ligne suivante :

Code:

ThisWorkbook.Sheets("Feuil1").Range("A" & 2 + j & "I" & 51 + j).Value = Wbk.Sheets(1).Range("A2:I51").Value

J'ai laissé Feuil1 comme nom de la feuille de destination puisque j'ouvre un fichier Excel vide dans lequel je crée la macro.

Se peut-il que cela provienne du fait que dans mes fichiers, la feuille n'a pas le même nom dans tous les fichiers (Contacts(1), Contacts(2), Contacts(3), etc...).

En tout cas, merci encore de ta réponse,

Pierre

Erreur dans range

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub test3()
Dim Wbk As Workbook
Dim Fich As String
Dim j As Long
 
Fich = Dir("C:\Contacts\*.xls")
Application.ScreenUpdating = False
Do While Fich <> ""
    Set Wbk = Workbooks.Open("C:\Contacts\" & Fich)
    ThisWorkbook.Sheets("Feuil1").Range("A" & 2 + j & ":I" & 51 + j).Value = Wbk.Sheets(1).Range("A2:I51").Value    'Adapte le nom Feuil1 à ta feuille destination
    j = j + 50
    Wbk.Close
    Set Wbk = Nothing
    Fich = Dir
Loop
End Sub

03/11/2010, 14h28
piercleo

Et bien un grand merci puisque je viens de rentrer de vacances et grâce à ta réponse j'ai pu réaliser ce que je souhaitais faire.

Bonne continuation,

Pierre