Discussion :

[yannick63430]

Bonjour à tous,

Je voudrais créer un fichier de synthèse qui récupère dans différents fichiers spécifiques, une plage de données et qui la colle dans un onglet de mon fichier synthèse.
J'ai donc fait des recherches sur le forum pour récupérer des données sans ouvrir un classeur excel :

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 ExtractionZ()
Dim Chemin As String
Dim w2 As Workbook
 
 Chemin = Sheets("chem").Range("C4").Value
 
Set w = GetObject(Chemin)
w.Sheets("Z - PS").Range("A5:K3100").Copy
 
 Workbooks("Synthèse.xlsm").Activate
 Sheets("PS").Select
 Range("A7").PasteSpecial xlPasteAll
        Application.CutCopyMode = False
 w.Close SaveChanges:=False
 End Sub

Une fois cela réaliser, j'ai voulu tester sur deux types fichiers :
- sur un fichier excel sans macro = ok
- sur un fichier excel avec des macros à l'ouverture et à la fermeture = cela bloque (à l'ouverture et je me doute qu'à la fermeture aussi!)
Les macros dans mon fichier sont entre autre :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Option Explicit
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not Autorise Then UserForm2.Show
Cancel = Not Autorise
End Sub
 
Private Sub Workbook_Open()
Sheets(1).Select
AncienneSomme = Cells(4, 2)
MsgBox "Date de clôture initiale = " & Format(AncienneSomme, "dd/mm/yy") & " "
End Sub

Et bien sûr, ce sont le second type de fichier qui m’intéresse!!!!!!!!

De même, je voudrais savoir s'il est possible de réaliser une boucle pour que la macro "Extraction" se fasse sur tous mes fichiers.

J'espère avoir été clair.
Merci d'avance pour votre aide.

Cordialement
yannick

[Daniel.C]

Bonjour,

"GetObject" ouvre le classeur (celui-ci est masqué). Pourquoi ne pas l'ouvrir avec la méthode "Open" ? Pour éviter un affichage répétitif, utilise la ligne :

Code :

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

Application.ScreenUpdating = False

Pour la boucle sur les fichiers, regarde l'aide sur la fonction Dir.

Ca pourrait ressembler à ça (non testé). Note que "Chemin" représente le chemin des fichiers et non pas un fichier particulier :

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
Sub ExtractionZ()
Dim Chemin As String
Dim w2 As Workbook
Dim w As Workbook
Dim Fichier As String
Application.ScreenUpdating = False
Chemin = Sheets("chem").Range("C4").Value 'représente le chemin, pas le fichier
Fichier = Dir(Chemin & "\*.xls*")
Do While Fichier <> ""
    Application.EnableEvents = False
    Set w = Workbooks.Open(Chemin)
    w.Sheets("Z - PS").Range("A5:K3100").Copy
    Application.EnableEvents = True
    Workbooks("Synthèse.xlsm").Activate
    Sheets("PS").Select
    Range("A7").PasteSpecial xlPasteAll
    Application.CutCopyMode = False
    w.Close SaveChanges:=False
    Fichier = Dir
 Loop
 Application.ScreenUpdating = True
 End Sub

[yannick63430]

Bonjour,

merci de ton aide.
D'après tes explications, je dois donc modifier la valeur de chemin :
En premier lieu, je définissais chemin comme ceci :

Code :

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

1
2
 
C:\Documents and Settings\YBEL.AGIRIS\Bureau\TEST\Z\Z - DA.xlsm

Il faut donc pour que Fichier soit défini, que chemin soit égal à :

Code :

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

1
2
 
C:\Documents and Settings\YBEL.AGIRIS\Bureau\TEST\Z

Cependant, une fois la modification réalisée, une erreur apparaît sur :

Code :

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

1
2
 
Set w = Workbooks.Open(Chemin)

Cordialement

Re

j'ai donc modifié la macro pour qu'elle ouvre le fichier sélectionné et c'est bon :

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
 
Sub ExtractionZk()
Dim Chemin As String
Dim chemin1 As String
Dim w2 As Workbook
Dim w As Workbook
Dim Fichier As String
Application.ScreenUpdating = False
Chemin = Sheets("chem").Range("C4").Value 'représente le chemin, pas le fichier
chemin1 = Sheets("chem").Range("D4").Value '
Fichier = Dir(Chemin & "\*.xls*")
Do While Fichier <> ""
    Application.EnableEvents = False
    Set w = Workbooks.Open(chemin1)
    w.Sheets("Z - PS").Range("A5:K3100").Copy
    Application.EnableEvents = True
    Workbooks("Synthèse.xlsm").Activate
    Sheets("PS").Select
    Range("A7").PasteSpecial xlPasteAll
    Application.CutCopyMode = False
    w.Close SaveChanges:=False
    Fichier = Dir
 Loop
 Application.ScreenUpdating = True
 End Sub

Cependant, je n'arrive pas à passer outre la macro de fermeture du fichier ouvert.

Cordialement

[Daniel.C]

Exact, nom d'un petit bonhomme ! Il faut faire comme pour l'ouverture :

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
Sub ExtractionZk()
Dim Chemin As String
Dim chemin1 As String
Dim w2 As Workbook
Dim w As Workbook
Dim Fichier As String
Application.ScreenUpdating = False
Chemin = Sheets("chem").Range("C4").Value 'représente le chemin, pas le fichier
chemin1 = Sheets("chem").Range("D4").Value '
Fichier = Dir(Chemin & "\*.xls*")
Do While Fichier <> ""
    Application.EnableEvents = False
    Set w = Workbooks.Open(chemin1)
    w.Sheets("Z - PS").Range("A5:K3100").Copy
    Application.EnableEvents = True
    Workbooks("Synthèse.xlsm").Activate
    Sheets("PS").Select
    Range("A7").PasteSpecial xlPasteAll
    Application.CutCopyMode = False
    Application.EnableEvents = False
    w.Close SaveChanges:=False
    Application.EnableEvents = True
    Fichier = Dir
 Loop
 Application.ScreenUpdating = True
 End Sub