Copie de d'une feuille de plusieurs fichiers excel dans un autre fichier par macro

**44jeje44** · 19/03/2010, 01h38

Bonsoir,

J'ai recherché dans différents forums et je ne trouve pas la solution à mon problème.

Explication de mon problème :
J'ai 6 fichiers Excel dans un même dossier qui peut être déplacé.

Le fichier General.xls a 6 onglets :
Feuil1 (A)
Feuil2 (B)
...
Feuil5 (E)
Feuil6 (Synthese)

Les 5 autres : A.xls ; B.xls ; C.xls ; D.xls ; E.xls ont juste un onglet Feuil1 (Feuil1)

Je voudrais en lançant une macro, copier l'onglet des 5 fichiers annexes dans le principal à leur emplacement respectif sans à avoir à ouvrir tous les fichiers.

Je voudrais éviter d'ouvrir tous les fichiers et faire une macro de ce type.

Code :

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

1
2
3
4
5
6
7
Windows("A.xls").Activate
Cells.Select
Selection.Copy
Windows("Syntese").Activate
Sheets("A").Select
Cells.Select
ActiveSheet.Paste

Merci de m'éclairer sur ce problème, j'ai déjà réussi à faire ma macro de synthèse, mais là je bloque.

**phiiris** · 19/03/2010, 22h34

Je ne vois pas comment vous pourriez copier/coller des cellules d'un fichier non ouvert.
Une solution LOURDE serait peut-être de mettre dans les cellules de votre fichier de synthèse les valeurs des fichiers A B C... avec simplement ='[A.xls]Feuil1'!A1 et recopier ça pour toutes les cellules. Lors de l'ouverture du fichier, excel vas demander s'y faut ou non mettre à jour. J'avais dit lourd !

Le plus simple de faire ouvrir et fermer les différents fichiers par la macro.

**sabzzz** · 20/03/2010, 14h17

bonjour,

'voici un exemple utilisant GetExternalData
c'est très rapide mais le classeur "cible" doit comporter une référence à la
'bibliothèque Microsoft ActiveX Data Objects 2.x Library.

Code :

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

1
2
3
4
5
6
7
8
Sub LireClasseurFermer()
 Dim Fich$, Arr
 Fich = "c:\zz\A.xls"  'Répertoire et nom de fichier à adapter
 GetExternalData Fich, "Feuil1", "A1:C10", False, Arr
 With ThisWorkbook.Sheets("Feuil1")
  .Range("A1", .Cells(UBound(Arr, 1), UBound(Arr, 2))).Value = Arr
 End With
 End Sub

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
Sub GetExternalData(srcFile As String, _
          srcSheet As String, _
          srcRange As String, _
          TTL As Boolean, _
          outArr As Variant)
 'd'après Héctor Miguel, mpep
 Dim myConn As ADODB.Connection, myCmd As ADODB.Command
 Dim HDR As String, myRS As ADODB.Recordset, RS_n As Integer, RS_f As Integer
 Dim Arr
 
 Set myConn = New ADODB.Connection
 If TTL = True Then HDR = "Yes" Else HDR = "No"
 myConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
       "Data Source=" & srcFile & ";" & _
       "Extended Properties=""Excel 8.0;" & _
       "HDR=" & HDR & ";IMEX=1;"""
 Set myCmd = New ADODB.Command
 myCmd.ActiveConnection = myConn
 If srcSheet = "" _
  Then myCmd.CommandText = "SELECT * from `" & srcRange & "`" _
  Else myCmd.CommandText = "SELECT * from `" & srcSheet & "$" & srcRange & "`"
 Set myRS = New ADODB.Recordset
 myRS.Open myCmd, , adOpenKeyset, adLockOptimistic
 ReDim Arr(1 To myRS.RecordCount, 1 To myRS.Fields.Count)
 myRS.MoveFirst
 Do While Not myRS.EOF
  For RS_n = 1 To myRS.RecordCount 'lignes
   For RS_f = 0 To myRS.Fields.Count - 1 'colonnes
    Arr(RS_n, RS_f + 1) = myRS.Fields(RS_f).Value
   Next
   myRS.MoveNext
  Next
 Loop
 myConn.Close
 Set myRS = Nothing
 Set myCmd = Nothing
 Set myConn = Nothing
 outArr = Arr
 End Sub

isabelle

**vincent25260** · 20/03/2010, 20h32

bonsoir
je pense que pour ta recherche il faut que tu travaille
avec un fichier principal et des exclaves,
c'est que tu as déjà fait,
pour le reste utilise la fontion importation de données dans le menu données/importer données
Ne pas oublier de cocher "mise à jour à l'ouverture" dans la proprièté
de la fonction.
T'as pas besoin de macro pour le faire fonctionner.
A l'ouverture du fichier principal ,il faut mettre à jour les données.
Il ira regarder dans les fichiers exclaves et il va comparer avec le fichier principal et il modifira les données.

**rvtoulon** · 21/03/2010, 09h38

Bjr, Le Forum
plusieurs possibilité existe pour réaliser ce que tu souhaites faire et une recherche dans la

donne ceci:http://excel.developpez.com/faq/?pag...lasseursFermes ou encore :http://silkyroad.developpez.com/VBA/ClasseursFermes/, merci Silkyroad.

d'autres part cette question a été posée a de multiples reprises dans le forum macro de Excel, un exemple ici :http://www.developpez.net/forums/d83...onnees-fermer/ , il y en a bien d'autres

Bonne Lecture,
@+

**44jeje44** · 21/03/2010, 10h54

Merci pour tes lien il correspond à ma demande.

Je n'avait pas trouvé ce lien lors de mes recherche.

**44jeje44** · 21/03/2010, 11h02

Juste une question comment je peu faire modifier automatiquement le dossier cible.

Car le fichier principal et ses sous fichier son dans un dossier qui peut être déplacé.

**44jeje44** · 21/03/2010, 14h31

J'ai trouvé cette solution mais comment je peu faire pour remplacer la copie de la sélection par l'onglet entier ?

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
Sub Actualiser()
 
Dim wb As Workbook
Dim ws As Worksheet
 
dossier = ThisWorkbook.Path
 Worksheets("Synthese").Cells(1, 1) = dossier
 
'Copie IW3M
Set wb = Workbooks.Open(dossier & "\IW3M.xls")
Set ws = wb.Worksheets("Feuil1")
 
Workbooks(1).Sheets("IW3M").Range("A1:IV3000").Value = ws.Range("A1:IV3000").Value
 
wb.Close dontsave = True
 
 
'Copie IW29
Set wb = Workbooks.Open(dossier & "\IW29.xls")
Set ws = wb.Worksheets("Feuil1")
 
Workbooks(1).Sheets("IW29").Range("A1:IV3000").Value = ws.Range("A1:IV3000").Value
 
wb.Close dontsave = True
 
 
'Copie IW39
Set wb = Workbooks.Open(dossier & "\IW39.xls")
Set ws = wb.Worksheets("Feuil1")
 
Workbooks(1).Sheets("IW39").Range("A1:IV3000").Value = ws.Range("A1:IV3000").Value
 
wb.Close dontsave = True
 
 
'Copie IW47
Set wb = Workbooks.Open(dossier & "\IW47.xls")
Set ws = wb.Worksheets("Feuil1")
 
Workbooks(1).Sheets("IW47").Range("A1:IV3000").Value = ws.Range("A1:IV3000").Value
 
wb.Close dontsave = True
 
 
'Copie IW69
Set wb = Workbooks.Open(dossier & "\IW69.xls")
Set ws = wb.Worksheets("Feuil1")
 
Workbooks(1).Sheets("IW69").Range("A1:IV3000").Value = ws.Range("A1:IV3000").Value
 
wb.Close dontsave = True
 
End Sub

**rvtoulon** · 21/03/2010, 19h11

Re,

mais comment je peu faire pour remplacer la copie de la sélection par l'onglet entier ?

En regardant cet autre lien:
http://www.developpez.net/forums/d40...asseur-lautre/

@+

**44jeje44** · 22/03/2010, 09h20

J'ai écrit ces lignes mais le problème est que ça crés des nouveau onglet au lieu d'écrire dans un existant.

Qui peut me guider sur ce 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
Sub Actualiser()
 
Dim wb As Workbook
Dim ws As Worksheet
 
dossier = ThisWorkbook.Path
 
'Copie IW3M
Set wb = Workbooks.Open(dossier & "\IW3M.xls")
Set ws = wb.Worksheets("Feuil1")
 
ws.Copy after:=Workbooks(1).Sheets("IW3M")
 
wb.Close dontsave = True
 
End Sub

**rvtoulon** · 22/03/2010, 10h46

Slt,
dans ton code remplace:

Code :

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

ws.Copy after:=Workbooks(1).Sheets("IW3M")

par:

Code :

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

ws.Cells.Copy Workbooks(1).Sheets("IW3M").Range("A1")

en fait tu copy l'ensemble des cellules de ta feuille source dans ta feuille destination.
@+

**44jeje44** · 22/03/2010, 11h29

Merci pour toutes tes réponses rvtoulon.

J'ai le résultats que je voulais.

**rvtoulon** · 22/03/2010, 14h07

Salut,
pour le fun en appliquant le tuto de silkyroad, un exemple qui copie chaque feuille 1 de chaque classeur fermé d'un dossier dans une feuille différente du classeur qui reçoit les données.
ex: classeur1 feuil1 dans bilan feuil1, classeur2 feuil1 dans bilan feuil2 etc...
Le classeur qui contient la macro doit etre dans ce dossier. Comme dit dans le tuto,

Vous devez préalablement activer la référence Microsoft ActiveX Data Objects x.x Library pour utiliser les exemples présentés dans ce tutoriel.

Dans l'éditeur de macros:
Menu Outils.
Références.
Cochez la ligne "Microsoft ActiveX Data Objects x.x Library".
Cliquez sur le bouton OK pour valider.

x.x dépend de la version installée sur votre poste.

Pour EXCEL 2007 :

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
Sub CopieFeuilleClasseurFerme()
 
    Dim Cn As ADODB.connection
    Dim Fichier As String, chemin As String, i As Long
    Dim NomFeuille As String, texte_SQL As String
    Dim Rst As ADODB.Recordset
    Dim wb As Workbook
 
    'Définit le dossier du fichier en cours
    chemin = ThisWorkbook.Path
 
    'Définit les classeurs fermés servant de base de données
    Fichier = Dir(chemin & "\*.xls")
 
    'Nom de la feuille dans le classeur fermé
    NomFeuille = Sheets(1).Name
 
    i = 1
 
    Do While Fichier <> ""
    If Fichier <> ThisWorkbook.Name Then
 
    Set Cn = New ADODB.connection
 
    '--- Connection ---
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"""
        .Open
    End With
    '-----------------
 
    'Définit la requête.
    '/!\ Attention à ne pas oublier le symbole $ après le nom de la feuille.
    texte_SQL = "SELECT * FROM [" & NomFeuille & "$]"
 
    Set Rst = New ADODB.Recordset
    Set Rst = Cn.Execute(texte_SQL)
 
    'Ecrit le résultat de la requête dans la cellule A2
    Sheets(i).Range("A1").CopyFromRecordset Rst
 
    '--- Fermeture connexion ---
    Cn.Close
    Set Cn = Nothing
    i = i + 1
    End If
    Fichier = Dir
    Loop
End Sub

Et pour EXCEL 2003, remplacer :

Code :

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

1
2
3
4
5
6
 With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & Fichier & ";Extended Properties=""Excel 12.0;HDR=NO;"""
        .Open
    End With

par :

Code :

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

1
2
3
4
5
6
With Cn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & Fichier & _
            ";Extended Properties=Excel 8.0;HDR=NO"
        .Open
    End With

comme je n'ai que excel 2007 si on suis le tuto ceci devrait fonctionner.

Bonne journée à tous

Copie de d'une feuille de plusieurs fichiers excel dans un autre fichier par macro

Macros et VBA Excel

Discussions similaires

Partager

Partager