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 test()
'On crée une variable 'wbFusion' de type Classeur Excel
Dim wbFusion As Workbook
'On l'associe au classeur à partir duquel tu lances la macro
Set wbFusion = ThisWorkbook
'On crée une variable wbCible qui va correspondre tour à tour aux classeur à importer
Dim wbCible As Workbook
Dim shCible As Worksheet
'Afin de lui affecter des fichiers, l'utilisateur va les sélectionner via une boîte de dialogue
'NOTA : le With XXXXXXXXX évite de répéter plein de fois XXXXXXXXX lorsque l'on parle de la même chose ;)
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Choisissez le(s) classeur(s) à importer"
.Filters.Add "Classeur Excel", "*.xls,*.xls?,*xlsx" 'on filtre par tous les fichiers .xls et xls? avec '?' signifiant "1 caractère"
.ButtonName = "Importer ce(s) classeur(s)"
.AllowMultiSelect = True 'on autorise la sélection multiple
.Show 'on affiche la fenêtre, on attend le retour de l'utilisateur pour continuer
'on a réglé la boîte de dialogue, maintenant il faut traiter les données de l'utilisateur :
'si l'utilisateur n'a pas sélectionné de fichier, on met un message d'erreur
If .SelectedItems.Count = 0 Then
MsgBox "Veuillez sélectionner au moins un fichier", vbExclamation, "Erreur"
'Sinon, on traite :
Else
For i = 1 To .SelectedItems.Count
'On ouvre chaque classeur un par un
Set wbCible = Workbooks.Open(.SelectedItems(i))
CouleurOnglet = RGB(Rnd * 255, Rnd * 255, Rnd * 255) 'on va mettre toutes les pages de ce classeur importées avec l'onglet de la même couleur
CompteurClasseur = CompteurClasseur + 1 'on incrémente un compteur, facultatif
CompteurFeuille = 1 'xxx
CompteurTest = 1 'xxx
'Pour chaque feuille du wbCible :
For Each shCible In wbCible.Sheets
shCible.Tab.Color = CouleurOnglet
shCible.Name = wbCible & "_" & CompteurFeuille 'nom de la feuille
shCible.Copy after:=wbFusion.Sheets(wbFusion.Sheets.Count) 'on la copie à la fin de wbFusion
CompteurFeuille = CompteurFeuille + 1 'on incrémente un compteur, facultatif
CompteurTest = CompteurTest + 1 'xxx
Next shCible
'On ferme le classeur sans enregistrer (on a changé le nom des pages avant copie)
wbCible.Close SaveChanges:=False
'On passe au classeur suivant
Next i
'Facultatif, à l'aide des compteurs, on indique à l'utilisateur que tout s'est bien passé
MsgBox CompteurTest & " feuilles ont bien été importées, provenant de " & CompteurClasseur & " classeurs Excel.", vbInformation, "Import réussi"
End If
End With
End Sub |
