Discussion :

[elkhy]

Bonjour,

je dispose de 200 fichiers excel dans un répertoire.
je souhaite ajouter un onglet supplementaire (contenant des données) dans tous ces fichiers.
Cela est-il possible à faire en automatique ?

merci à tous pour vos réponses

[elkhy]

Bonjour,

Après reflexion voici une précision sur ma demande qui j'espère sera plus facile à traiter que la première:

je dispose de 200 fichiers excel dans un répertoire.
je voudrai faire la chose suivante que je suis incapable d'écrire en vba...
Récupérer dans chacun de ces fichiers les cellules A10 D10 H10 J10 D54 H54.
une fois ces cellules récupérées, je voudrai placer dans une feuille et dans un classeur à part
les noms des fichiers avec à côté ces cellules.
Tout ceci afin d'avoir une vision globale de tous les fichiers avec les données qu'ils comportent dans ces cellules (A10 D10 H10 J10 D54 H54).
Afin de m'éviter d'ouvrir chaque fichier, puis faire 200 copier coller * le nombre de cellule..

D'avance merci pour votre aide

[SilkyRoad]

bonsoir

j'espere que cette macro pourra t'aider
cet exemple suppose que tous les classeurs fermés contiennent une feuille nommé "Feuil1"

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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
 
Option Explicit
Option Base 1
 
Sub importCellules_ClasseursFermes()
'
'Necessite d'activer la reference Microsoft ActiveX Data Object 2.x Library
'
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim ADOCmd As ADODB.Command
Dim Fichier As String, Direction As String
Dim Repertoire As String, Feuille As String
Dim X As Integer, NbFichiers As Integer, i As Integer
Dim Tableau() As String
Dim Cellule()
 
Repertoire = "C:\Documents and Settings\michel\dossier"
 
'Boucle pour lister tous les classeur du repertoire cible
Direction = Dir(Repertoire & "\*.xls")
Do While Len(Direction) > 0
    NbFichiers = NbFichiers + 1
    ReDim Preserve Tableau(1 To NbFichiers)
    Tableau(NbFichiers) = Direction
    Direction = Dir()
Loop
 
'adresse des cellules contenant les valeurs à recuperer
Cellule = Array("A10", "D10", "H10", "J10", "D54", "H54")
 
'tous les classeurs fermés doivent contenir un onglet nommé "Feuil1"
Feuille = "Feuil1$" 'n'oubliez pas d'ajouter $ au nom de la feuille
 
If NbFichiers > 0 Then
    For X = 1 To NbFichiers 'boucle sur les classeurs
 
        'pour ne pas prendre en compte le classeur contenant la macro
        If Tableau(X) <> ThisWorkbook.Name Then
 
            Cells(X, 1) = Tableau(X)
 
            Fichier = Repertoire & "\" & Tableau(X)
 
            Set Source = New ADODB.Connection
            Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
 
            For i = 1 To UBound(Cellule)
 
                Set ADOCmd = New ADODB.Command
                With ADOCmd
                .ActiveConnection = Source
                'les données sont dans la "Feuil1" des classeurs fermés
                .CommandText = _
                "SELECT * FROM `" & Feuille & Cellule(i) & ":" & Cellule(i) & "`"
                End With
 
                Set Rst = New ADODB.Recordset
                Rst.Open ADOCmd, , adOpenKeyset, adLockOptimistic
 
                Set Rst = Source.Execute("`" & Feuille & _
                Cellule(i) & ":" & Cellule(i) & "`")
 
                Cells(X, i + 1) = Rst.Fields(0).Value
 
                Rst.Close
                Set Rst = Nothing
                Set ADOCmd = Nothing
            Next i
 
            Source.Close
            Set Source = Nothing
 
        End If
    Next X
End If
End Sub

bon week end
michel

[elkhy]

salut,

tout d'abord un grand Merci à toi...

j'ai essayé de tester ce code...mais je n'y arrive pas.


J'ai placé ton code dans une feuille de prog visal basic d'un fichier excel...
J'ai coché la reference Microsoft ActiveX Data Object 2.8 Library.
J'ai changé le nom de ma feuille sans oublier le $


A l'exécution j'ai l'erreur suivante:

Erreur d'exécution '_2147217900(80040e14)':
Erreur Automation

Comme il ne m'indiquait pas l'emplacement, j'ai fait une exécution pas à pas, et voici ou le message apparaît:

Rst.Open ADOCmd, , adOpenKeyset, adLockOptimistic

Set Rst = Source.Execute("`" & Feuille & _
Cellule(i) & ":" & Cellule(i) & "`")

Peux-tu me dire ce que j'ai fait d'incorrect ?

d'avance merci

[SilkyRoad]

rebonsoir

je ne sais quoi répondre puisque cela fonctionne chez moi (OfficeXP)...

tu as bien adapté le nom de la feuille contenue dans les classeurs fermés ?


bonne soiree
michel

[elkhy]

Bonjour SilkyRoad,le forum

Effectivement ton code marche très bien.

C'est moi qui avait fait une erreur: mon onglet est nommé "4. monOnglet"
et apparemment il n'accepte pas l'espace.
Donc "4.monOnglet" sans espace marche très bien et "Feuil1" aussi.

Il me reste juste à te demander si je peux en automatique changer l'ensemble de mes onglets ou alors le faire à la main ?

Merci, et excuse moi si tu as cherché mon erreur pour rien..

@+

[elkhy]

Bonjour à tous,
J'ai un dossier qui contient plusieurs fichiers Excel.
Je lis chacun de ces fichiers de ce dossier afin de pouvoir
récupérer leurs données.
Pour faire cela, j'ai une macro qui récupère le nom du fichier, et 4 cellules pour l'instant.
Actuellement, j'arrive à récupérer une ligne (avec l'aide de Sylkiboard).
Mon souci est que je n'arrive pas à récupérer toutes les lignes du fichier (à cause de leurs dispositions)
afin de pouvoir les mettre en forme de la manière suivante:
NomFichier1 numLibelle Libelle Val
....
....
NomFichier2 numLibelle Libelle Val
....
...
NomFichier3 numeLibelle Libelle val
etc

Ci-joint un fichier Exemple (fichierExemple.xls),(car je sais que je ne suis pas très clair)qui montre comment les données sont disposées (la disposition est la même pour tous les fichiers)
Le fichier SearchCellsFichier.xls, ou il y a la macro sur la Feuil1, ainsi que le résultat que je n'arrive pas à obtenir (sur la feuille "ficCible").

Merci à tous pour votre aide

[ouskel'n'or]

Hello,

Avant d'ouvrir ton zip, peux-tu indiquer la version de ton Excel (je n'ai que VBA97)

A tout'

[elkhy]

Salut ouskel'n'or, le forum,

Je suis sous Excel 2003.

Pensant que ma demande n'est pas suffisamment précise ou claire, j'ai rédigé ma demande autrement....la voici:

J'ai un dossier qui contient plusieurs fichiers Excel.
Je lis chacun de ces fichiers de ce dossier afin de pouvoir
récupérer les données d'un onglet spécifique.

Voici 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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
 
Option Explicit
Option Base 1
 
Sub importCellules_ClasseursFermes()
'
'Necessite d'activer la reference Microsoft ActiveX Data Object 2.x Library
'
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim ADOCmd As ADODB.Command
Dim Fichier As String, Direction As String
Dim Repertoire As String, Feuille As String
Dim X As Integer, NbFichiers As Integer, i As Integer
Dim Tableau() As String
Dim Cellule()
 
Repertoire = "C:\documents and Settings\repFicExemple"
 
'Boucle pour lister tous les classeur du repertoire cible
Direction = Dir(Repertoire & "\*.xls")
Do While Len(Direction) > 0
    NbFichiers = NbFichiers + 1
    ReDim Preserve Tableau(1 To NbFichiers)
    Tableau(NbFichiers) = Direction
    Direction = Dir()
Loop
 
'adresse des cellules contenant les valeurs à recuperer
Cellule = Array("A15", "D15", "E15", "F15")
 
'tous les classeurs fermés doivent contenir un onglet nommé "Feuil1"
Feuille = "Feuil1$" 'n'oubliez pas d'ajouter $ au nom de la feuille
 
If NbFichiers > 0 Then
    For X = 1 To NbFichiers 'boucle sur les classeurs
 
        'pour ne pas prendre en compte le classeur contenant la macro
        If Tableau(X) <> ThisWorkbook.Name Then
 
            Cells(X, 1) = Tableau(X)
 
            Fichier = Repertoire & "\" & Tableau(X)
 
            Set Source = New ADODB.Connection
            Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;HDR=No;"";"
 
            For i = 1 To UBound(Cellule)
 
                Set ADOCmd = New ADODB.Command
                With ADOCmd
                .ActiveConnection = Source
                'les données sont dans la "Feuil1" des classeurs fermés
                .CommandText = _
                "SELECT * FROM `" & Feuille & Cellule(i) & ":" & Cellule(i) & "`"
                End With
 
                Set Rst = New ADODB.Recordset
                Rst.Open ADOCmd, , adOpenKeyset, adLockOptimistic
 
                Set Rst = Source.Execute("`" & Feuille & _
                Cellule(i) & ":" & Cellule(i) & "`")
 
                Cells(X, i + 1) = Rst.Fields(0).Value
 
                Rst.Close
                Set Rst = Nothing
                Set ADOCmd = Nothing
            Next i
 
            Source.Close
            Set Source = Nothing
 
        End If
    Next X
End If
End Sub

Voici ce qu'il donne actuellement:
NomDuFichier1 ValCellA15 ValCellD15 ValCellE15 ValCellF15
NomDuFichier2 ValCellA15 ValCellD15 ValCellE15 ValCellF15
NomDuFichier3 ValCellA15 ValCellD15 ValCellE15 ValCellF15
...etc

J'affiche donc le nom de mon fichier suivi des 4 cellules que j'ai spécifié ici dans mon code:
Cellule = Array("A15", "D15", "E15", "F15")

En fait je voudrai récupérer plus que ces 4 cellules de mon fichier.

Voici comment ces données sont organisées dans mon fichier:
A15 D15 E15 F15 H15 J15 K15 L15
A17 D17 E17 F17 H17 J17 K17 L17
A19 D19 E19 F19 H19 J19 K19 L19

Voici ma question:
En l'état actuel du code comment puis-je faire pour obtenir une organisation des données comme cela:
NomDuFichier1 1 A15 D15
NomDuFichier1 2 A15 E15
NomDuFichier1 3 A15 F15
NomDuFichier1 1 A17 D17
NomDuFichier1 2 A17 E17
NomDuFichier1 3 A17 F17
NomDuFichier1 1 A19 D19
NomDuFichier1 2 A19 E19
NomDuFichier1 3 A19 F19
NomDuFichier1 1 H15 J15
NomDuFichier1 2 H15 K15
NomDuFichier1 3 H15 L15
NomDuFichier1 1 H17 J17
NomDuFichier1 2 H17 K17
NomDuFichier1 3 H17 L17
NomDuFichier1 1 H19 J19
NomDuFichier1 2 H19 K19
NomDuFichier1 3 H19 L19
...etc pour les autres fichiers

Merci à tous pour votre aide

[ouskel'n'or]

Toujours pas résolu ?

A+