Copier 3 fichiers excel dans 1.
Bonjour le forum!!!
J'espère que vous allez tous bien!
Je viens vous voir pour un petit problème, en effet, je souhaite copié 3 fichiers excel dans un seul et meme fichier (nommer concaténation_fichier.xls) voila mon 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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
| '----------------------------------Concaténation des fichiers M & M-2------------------------
'On Error GoTo Gestion_Erreur_1
MsgBox " Sélectionner la Facture N"
Set WB = ThisWorkbook 'tu definis WB comme le workbook dans lequel tu travailles
fichier_a_ouvrir = Application.GetOpenFilename 'ouverture d'une boite de dialogur pour selectionner ton deuxième fichier (renvoie le nom du fichier)
Set fichier_a_traité = Application.Workbooks.Open(fichier_a_ouvrir) 'ouverture du fichier selectionné
Chemin_dossier = InputBox("Chemin du dossier: ", "Chemin du dossier", "Veuillez rentrer le chemin du dossier(sans le \ à la fin du chemin)")
'On Error GoTo Gestion_Erreur_1
With fichier_a_traité
ChDir Chemin_dossier
.SaveAs Filename:= _
"Concaténation_fichier.xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
For Each wk In Worksheets
wk.Copy After:=.Sheets(.Sheets.Count) 'tu copies les feuilles vers WB
Next
'Gestion_Erreur_1:
'
'MsgBox ("Une erreur est survenue dans la procédure Nom_Feuilles " & "de l'application " & Err.Source & Chr(13) & ". Erreur n° " & Err.Number & ": " _
'& Err.Description)
'goto end sub
'----------------------------Compter le nombre de projet-----------------------------------------------------
Compteur = 0
For i_compteur = 1 To Sheets.Count 'Pour i_compteur = 1 jusqu'au nombre total de Feuilles.
PositionTiret = InStr(1, Sheets(i_compteur).Name, "-") 'Recherche du tiret
'controle_nom_F = ActiveSheet.Name
If PositionTiret > 0 Then 'And controle_nom_F <> "10 -Shared tools" ' Si il y a un tiret alors
Debut = Mid(Sheets(i_compteur).Name, 1, PositionTiret - 1) 'On Coupe le nom de la feuille avant le tiret pour n'avoir que le numéro
If IsNumeric(Debut) Then ' si ce qui est avant le tiret est numérique alors
Compteur = Compteur + 1 'On incrémente le compteur !
End If
End If
Next i_compteur
.Close (False) 'fermeture de fichier a traite sans sauvegarde
End With
'---------------------------------------------------------------------------------------------------------------
MsgBox " Sélectionner la Facture N-2"
fichier_a_ouvrir = Application.GetOpenFilename 'ouverture d'une boite de dialogur pour selectionner ton deuxième fichier (renvoie le nom du fichier)
Set fichier_a_traité = Application.Workbooks.Open(fichier_a_ouvrir) 'ouverture du fichier selectionné
Workbooks.Open Filename:=Chemin_dossier & "\Concaténation_fichier.xls"
Set fichier_ou_on_colle = Workbooks(Workbooks.Count)
With fichier_a_traité
For Each wk In .Worksheets
wk.Copy After:=fichier_ou_on_colle.Sheets(.Sheets.Count)
Next
.Close (False) 'fermeture de fichier a traite sans sauvegarde
End With
'---------------------Copie du fichier Code affaire dans concaténation_fichier------------------------
MsgBox " Sélectionner le tableau des codes affaires"
fichier_a_ouvrir = Application.GetOpenFilename 'ouverture d'une boite de dialogur pour selectionner ton deuxième fichier (renvoie le nom du fichier)
Set fichier_a_traité = Application.Workbooks.Open(fichier_a_ouvrir) 'ouverture du fichier selectionné
'Workbooks.Open Filename:=Chemin_dossier & "\Concaténation_fichier.xls"
Set fichier_ou_on_colle = Workbooks(Workbooks.Count)
With fichier_a_traité
For Each wk In .Worksheets
wk.Copy After:=fichier_ou_on_colle.Sheets(.Sheets.Count)
Next
'.Close (False) 'fermeture de fichier a traite sans sauvegarde
End With
fichier_ou_on_colle.Save |
malheureusement depuis que j'essaye de rajouter mon dernier fichier, je suis bloqué car il ne me sauvegarde pas l'étape du milieu ( donc la copie du fichier dit: " N-2" )
On espérant recevoir un peu d'aide...
Merci :roll:
