[VBA-E] ajout d'un onglet dans plusieurs fics

Version imprimable

12/05/2006, 16h53
elkhy

[VBA-E] ajout d'un onglet dans plusieurs fics

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
12/05/2006, 18h17
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

bonsoir

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

Code:

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

12/05/2006, 19h42
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
12/05/2006, 20h46
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
15/05/2006, 09h50
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..

@+

bonjour

ce n'est pas la peine de changer tous les noms de feuilles

il suffit de remplacer les quotes ' , par des crochets

Code:

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
 
'
'...
'
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
'
'...
'

bonne journée
michel

15/05/2006, 11h00
elkhy

re,

dsl, ça ne passe toujours pas même avec les crochets

dois-je metre aussi le nom de la feuille entre crochet ?

merci
@+
15/05/2006, 11h53
SilkyRoad

rebonjour

le probleme vient du point dans le nom de la feuille ...

bonne journée
michel
15/05/2006, 12h12
elkhy

Merci Silkyroad,

J'ai commencé à modifier les fichiers à la main et je suis presque à la fin, car j'ai tout tester donc bugg...lol, je n'arrive pas à voir pourquoi.

Je tenais à te remercier encore une fois pour ce code qui marchait très bien en fin de compte et qui m'avance bcp..

A bientôt...
16/05/2006, 16h09
elkhy

1 pièce(s) jointe(s)

[VBA-E] Mise en forme de cellules

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
16/05/2006, 19h56
ouskel'n'or

Hello,

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

A tout'

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:

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

17/05/2006, 19h22
ouskel'n'or

Toujours pas résolu ?

A+