Importation plusieurs fichiers, dans un fichier mais différents onglets

**levert74** · 28/10/2014, 20h16

Bonjour à tous,

Mon 1er post, merci pour votre indulgence.

Tout nouveau dans la communauté macro je cherche à compiler plusieurs fichiers excels (une feuille à chaque fois) dans un fichier excel avec plusieurs onglets.

Pour le moment, je suis arrivé à importer une feuille (entière) dans le 1er onglet de mon nouveau fichier et à traiter les données de mon dossier tel que je le souhaitais. Mon problème est que lorsque j'essaie d'importer la 2ème feuille sur le 2nd onglet, cela m'écrase la 1ère feuille.

Pour résumé j'ai plusieurs fichiers excel:
Worksheet A Feuille "Z"
Worksheet B Feuille "X"
Worksheet C Feuille "Y"
potentiellement d'autres importation sur les onglets suivant.

que je souhaite importer dans un seul mais sur les onglets différents:
Worsheet Final onglet 1 (=Worksheet A Feuille "Z"), onglet 2 (=Worksheet B Feuille "X"), onglet 3 (=Worksheet C Feuille "Y")....

Je pense que je dois utiliser les boucles -> worksheet +1 mais là mes connaissances coincent.

Une idée ou une piste pour m'aider décanter tout ca ?

Merci pour votre aide.

**RemiBousquet** · 28/10/2014, 21h19

Il manque un élément clef : quel genre de technique d'export vers Excel tu utilises ?
Ods ? libname vers classeur Excel ? Lien DDE ? autre ?

Idéalement poste un extrait de ton code qui ne marche pas, ça servira à tous ceux qui veulent améliorer ton code.
Rémi

**levert74** · 29/10/2014, 10h05

Envoyé par RemiBousquet

Il manque un élément clef : quel genre de technique d'export vers Excel tu utilises ?
Ods ? libname vers classeur Excel ? Lien DDE ? autre ?

technique d'export ?
tous mes fichiers sont ouverts car je dois les exporter de notre serveur interne, puis je les auve tous dans un fichier sur mon bureau ou se trouve la macro.

Envoyé par RemiBousquet

Idéalement poste un extrait de ton code qui ne marche pas, ça servira à tous ceux qui veulent améliorer ton code.
Rémi

Le voila. Comme j'ai melange l'enregistreur de macro avec des termes que je connais, je ne suis pas otpimise mais je ne desespere pas de l'ameliorer avec le temps.
Mes actions entre les importations ne sont pas optimisees pour le moment, mais ca fonctionne pour toutes les pages independemment (formatage et filtre en attendant d'ajouter des consignes plus elaborees utilisant conditions), mais le resultat me donne plusieurs workbook separes.
La derniere etape devrait recuperer une image sur le bureau et l insere dans un nouvel onglet. le probleme c'est qu'ele se retrouve inclut dans un des onglets cree.

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
Sub PreclarusSSU_Report() '
 
Workbooks("ActivationSummary.xls").Sheets("Study%20Start-Up%20Dashboard%20").Copy
    Cells.Select
    Cells.EntireColumn.AutoFit
    Rows("1:1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AF$27").AutoFilter Field:=6, Criteria1:=Array( _
        "Eligible for Participation", "Potential", "Qualified", "Submitted"), Operator:= _
        xlFilterValues
Workbooks("SiteOverview.xls").Sheets("Study%20Start-Up%20Dashboard%20").Copy
Rows("1:1").Select
    Range("M1").Activate
    Selection.AutoFilter
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveSheet.Range("$A$1:$AP$27").AutoFilter Field:=14, Criteria1:=Array( _
        "Eligible for Participation", "Potential", "Qualified", "Submitted"), Operator:= _
        xlFilterValues
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A:A,B:B,C:C,E:E").Select
    Range("E1").Activate
    ActiveWindow.SmallScroll ToRight:=8
    Range("A:A,B:B,C:C,E:E,J:J,K:K,L:L").Select
    Range("L1").Activate
    ActiveWindow.SmallScroll ToRight:=4
    Range("A:A,B:B,C:C,E:E,J:J,K:K,L:L,Q:Q,R:R,U:U").Select
    Range("U1").Activate
    ActiveWindow.SmallScroll ToRight:=22
    Range("A:A,B:B,C:C,E:E,J:J,K:K,L:L,Q:Q,R:R,U:U,AP:AP").Select
    Range("AP1").Activate
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 1
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A28").Select
    Columns("E:E").ColumnWidth = 38.86
    Columns("E:E").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("H:H").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=21
    Columns("AB:AB").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Rows("1:1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
     Cells.Select
    Cells.EntireColumn.AutoFit
    Rows("1:1").Select
    Selection.AutoFilter
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
     Rows("1:1").Select
    Selection.AutoFilter
Workbooks("Findings.xls").Sheets("Study%20Start-Up%20Dashboard%20").Copy             'la derniere etape doit me recuper un screenshot sur mon bureau et l inserer dans un autre onglet
ActiveSheet.Pictures.Insert("C:\Users\name\Desktop\Capture.PNG").Select
End Sub

Merci !

**levert74** · 29/10/2014, 10h52

J'ai rectifie le code et j'arrive maintenant a avoir tout ce que je veux mais dans des workbooks separes.

Comment les regroupes facilement dans un seul.
Et la question a 10 000$, comment une fois stockes dans un fichier, ne pas avoir a les ouvrir tous.
Merci !

Ici le dernier 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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
Sub PreclarusSSU_Report() '
 
Workbooks("ActivationSummary.xls").Sheets("Study%20Start-Up%20Dashboard%20").Copy
    Cells.Select
    Cells.EntireColumn.AutoFit
    Rows("1:1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 15773696
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AF$27").AutoFilter Field:=6, Criteria1:=Array( _
        "Eligible for Participation", "Potential", "Qualified", "Submitted"), Operator:= _
        xlFilterValues
Workbooks("SiteOverview.xls").Sheets("Study%20Start-Up%20Dashboard%20").Copy
Rows("1:1").Select
    Range("M1").Activate
    Selection.AutoFilter
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveSheet.Range("$A$1:$AP$27").AutoFilter Field:=14, Criteria1:=Array( _
        "Eligible for Participation", "Potential", "Qualified", "Submitted"), Operator:= _
        xlFilterValues
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A:A,B:B,C:C,E:E").Select
    Range("E1").Activate
    ActiveWindow.SmallScroll ToRight:=8
    Range("A:A,B:B,C:C,E:E,J:J,K:K,L:L").Select
    Range("L1").Activate
    ActiveWindow.SmallScroll ToRight:=4
    Range("A:A,B:B,C:C,E:E,J:J,K:K,L:L,Q:Q,R:R,U:U").Select
    Range("U1").Activate
    ActiveWindow.SmallScroll ToRight:=22
    Range("A:A,B:B,C:C,E:E,J:J,K:K,L:L,Q:Q,R:R,U:U,AP:AP").Select
    Range("AP1").Activate
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 1
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A28").Select
    Columns("E:E").ColumnWidth = 38.86
    Columns("E:E").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("H:H").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll ToRight:=21
    Columns("AB:AB").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Rows("1:1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
     Cells.Select
    Cells.EntireColumn.AutoFit
    Rows("1:1").Select
    Selection.AutoFilter
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
     Rows("1:1").Select
    Selection.AutoFilter
Workbooks("ClientSummarySSU.xls").Sheets("Sheet1").Copy
ActiveSheet.Pictures.

Insert("C:\Users\name\Desktop\Capture.PNG").Select
End Sub

**m.brahim** · 29/10/2014, 12h31

Bonjour,

Si j'ai bien compris, tu cherche à récupérer le contenu des feuilles Excel présentes dans différents classeurs et mettre le tout dans un seul classeur.
Si c'est le cas, je te propose cette solution:

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
79
80
81
82
83
84
85
86
87
88
89
 
/*le dossier projet contien uniquement les fichiers excel à utiliser*/
 
%LET rep = C:\projet ;
DATA test (DROP=rc) ;
	rc = FILENAME("rep", "&rep") ;
	dirId = DOPEN("rep") ;
	DO i=1 TO DNUM(dirId) ;
		rc = FILENAME("fic", TRIM("&rep.\")!!LEFT(DREAD(dirid,i))) ;
		ficId = FOPEN("fic") ;
		ficId1 = DREAD(dirid,i) ;
 
		numInfos = MAX(FOPTNUM(ficId),0) ;
		DO j=1 TO numInfos ;
			info = FOPTNAME(ficId, j) ;
			valeur = FINFO(ficId, info) ;
			PUT info "= " valeur ;
			output;
		END ;
		rc = FCLOSE(ficId) ; 
	END ;
	rc = DCLOSE(dirId) ;
RUN ; 
 
 
data test1(keep=valeur fic) ;
set test;
fic=substr(ficId1,1,length(ficId1)-4);
if j=1 then output;
run; 
 
%macro import();
data _null_;
set test1 end=last;
call symputx ('lib'||left(_n_),valeur);
call symputx ('fic'||left(_n_),fic);
if last then call symput ('nbr1',_n_);
run;
%put &fic2;
%do i=1 %to &nbr1;
libname lib&i "&&lib&i"; 
proc sql noprint;
create table tab&i as select memname
from sashelp.vtable
where upcase(LIBNAME) ="LIB&i" AND MEMNAME not like '%$' ;quit;
quit;
 
libname import "C:\import";
 
%macro cre(name);
data import.&&fic&i&name;
set lib&i..&name.;
run;
%mend;
 
DATA _null_;
SET tab&i;
call execute ("%cre ( " !! LEFT(memname) !! " );");
run; 
libname lib&i clear;
 
%end;
%mend ;
 
%import();
 
proc sql noprint;
create table fin as select memname
from sashelp.vtable
where upcase(LIBNAME) ="IMPORT"  ;quit;
quit;
 
%macro exportmultisheet;
data _null_;
set fin end=last;
call symputx ('fic'||left(_n_),memname);
if last then call symput ('nbr',_n_);
run;
 
%do i = 1 %to &nbr;
PROC EXPORT DATA = import.&&fic&i.
            OUTFILE="c:\sortie\final.xls"
            DBMS= excel
            REPLACE;
   sheet = "&&fic&i";
   RUN;
%END;
%mend exportmultisheet;
%exportmultisheet;

Cordialement

**levert74** · 29/10/2014, 19h20

Bonsoir,

Pour commencer, merci au modo de me remettre dans le droit chemin en publiant mon code sous le bon format.

Ensuite, merci pour la réponse. En effet, c'est ce que je recherche à faire sachant que chaque page aura également des modifications (formations, conditions...) que je reglerais séparement.

Concernant le code ci-dessus, je crains fort de devoir retourner dans mes cours car je ne vois pas trop ou mettre tous les noms de mes feuilles.
Je vomprend ou doit etre placé les dossiers (C:\projet). Pour rc, est ce nom de ma worksheet puis celle de la feuille.

Merci pour votre aide....je réalise que j'ai encore beaucoup (tout) à apprendre.

Bonne soirée

**m.brahim** · 29/10/2014, 20h11

Pour

je ne vois pas trop ou mettre tous les noms de mes feuilles.

==> récupéré par le code ci-dessous

J'ai ajouté des commentaires dans chaque partie du code.

J'ai également apporté quelque améliorations:

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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
 
%LET rep = C:\projet  /*==> répertoire des fichiers Excel */  ;
DATA test  ;
	rc = FILENAME("rep", "&rep") ;
	dirId = DOPEN("rep") ;
	DO i=1 TO DNUM(dirId) ;
		rc = FILENAME("fic", TRIM("&rep.\")!!LEFT(DREAD(dirid,i))) ;
		ficId = FOPEN("fic") ;
		ficId1 = DREAD(dirid,i) ;
 
		numInfos = MAX(FOPTNUM(ficId),0) ;
		DO j=1 TO numInfos ;
			info = FOPTNAME(ficId, j) ;
			valeur = FINFO(ficId, info) ;
			PUT info "= " valeur ;
			output;
		END ;
		rc = FCLOSE(ficId) ; 
	END ;
	rc = DCLOSE(dirId) ;
RUN ;
 
/*Récupérer l'ensemble des fichiers Excel (qui sont sous format xls ou bien xlsx ) présents dans le répertoire*/
 
data test1 (keep=fic ficId1 valeur);
   set test;
   where ficid1 contains 'xls';
   if index(ficid1,'xls') ge 1 then fic=substr(ficId1,1,length(ficId1)-4) ;
   if index(ficid1,'xlsx') ge 1 then fic=substr(ficId1,1,length(ficId1)-5);
   if j=1 then output;  
run; 
 
/*Partie importation des données de chaque feuille de chaque fichier dans sas*/ 
 
%macro import();
data _null_;
set test1 end=last;
call symputx ('lib'||left(_n_),valeur); /*chemin complet de Classeur excel stocké dans des macros variable  */
call symputx ('fic'||left(_n_),fic);/*Nom de chaque classeur stocké dans des macros variable*/
if last then call symput ('nbr1',_n_);/*Nombre de fichiers présents stocké dans une macros variable*/
run;
 
%do i=1 %to &nbr1;
libname lib&i "&&lib&i"; /*Nom de source de données là en l’occurrence les noms des classeurs déclarée plus haut*/
 
/*Dans cette étape, je cherche les noms des feuille présentes dans chaque classeur*/
proc sql noprint;
create table tab&i as select memname
from sashelp.vtable
where upcase(LIBNAME) ="LIB&i" AND MEMNAME not like '%$' ;quit;
quit;
 
/*Création d'un dossier où stocké les données de chaque feuille importée*/
 
libname import "C:\Users\HP G72\Desktop\sortie\import";
 
%macro cre(name);
data import.&&fic&i&name; /*création des tables sas qui ont pour nom : le nom du classeur + le nom de la feuille*/
set lib&i..&name.;
run;
%mend;
 
DATA _null_;
SET tab&i;
call execute ("%cre ( " !! LEFT(memname) !! " );");
run; 
libname lib&i clear;
 
%end;
%mend ;
 
%import();
 
/*Partie exportation de l'ensemble de tables vers un fichier excel*/
 
proc sql noprint;
create table fin as select memname
from sashelp.vtable
where upcase(LIBNAME) ="IMPORT"  ;quit;
quit;
 
%macro exportmultisheet;
data _null_;
set fin end=last;
call symputx ('fic'||left(_n_),memname);
if last then call symput ('nbr',_n_);
run;
 
%do i = 1 %to &nbr;
PROC EXPORT DATA = import.&&fic&i.
            OUTFILE="C:\sortie\final.xls"
            DBMS= excel
            REPLACE;
   sheet = "&&fic&i";
   RUN;
%END;
%mend exportmultisheet;
%exportmultisheet;
 
/*suppression des tables sas après exportation des données*/
 
proc datasets lib=import kill nolist memtype=data;
quit;

Cordialement

Importation plusieurs fichiers, dans un fichier mais différents onglets

Macro

Discussions similaires

Partager

Partager