Bonjour à tous, ceci est mon 1er message sur le forum. Désolé si je fais des erreurs dans la façon dont je vous présente mon code.
J'essaye de rassembler 4 fichiers et de les copier/coller dans un fichier déjà existant que l'ont va appeler Extraction (sur le même répertoire). Les 4 fichiers sont des extractions et je n'ai pas le choix de leur format : .xls (Excel 97-2003). J'ai le choix du format de Extraction sur lequel je veux copier les 4 fichiers.
Les 4 fichiers ont le même format (mêmes colonnes), je souhaite garder celui-ci pour Extraction également. Donc ça simplifie les choses.
NOTE : Le fichier où il y a la macro est dans un autre répertoire.
Cela devrait être plutôt simple mais le nom du fichier ne s'incrémente quand je balaye le répertoire et pas et reste tout le temps le même. Je vois ça avec le MsgBox que j'ai mis dans la boucle while. A noter que la boucle est infini puisque rien ne s'incrémente...
Qu'est-ce que je ne comprends pas ?
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 Importation() 'indiquer le chemin du répertoire où nous travaillons Dim chemin_fichier_extraction As String chemin_fichier_extraction = "d:\Users\bliblou\blabla\" 'Le fichier Extraction et onglet qui nous concernent dans ce répertoire (la où nous voulons copier les 4 fichiers) Dim Wb_extraction As Workbook Dim Nom_du_Fichier As String: Nom_du_Fichier = "Extraction" Dim Ws_extraction As Worksheet Dim derniereLigne_exctraction As Integer 'le fichier où il y a la macro Dim Wb_actualisation As Workbook Dim Ws_ListeComplete As Worksheet Dim derniereLigne_ListeComplete As Integer Set Wb_actualisation = ThisWorkbook Dim chemin As String ' classeur regroupé Dim rep As String ' répertoire à traiter Dim fic As String ' classeur regroupé Dim WI As Worksheet ' feuille regroupement 'le répertoire est un répertoire fils où se trouve la macro rep = Wb_actualisation.Path & "\Importation en masse SIAM\" ' jusqu'ici il s'ouvre bien Set Wb_extraction = Application.Workbooks.Open(rep & Nom_du_Fichier) Set Ws_ListeComplete = ThisWorkbook.ActiveSheet ' variable feuille où l'on supprime ce qu'il y avait avant Ws_ListeComplete.Cells.ClearContents 'Qu'importe que je mette "*. *" ou "*.xlsm" ou "*.xls", il m' affiche constamment la même chose Cad le fichier "Extraction.xlsm" fic = Dir(rep & "*.xls") ' recherche fichiers While fic <> "" MsgBox (fic) If fic <> Wb_extraction.Name Then chemin = rep & fic ' chemin fichiers Workbooks.Open chemin, 0 ' ouverture Set Wl = ActiveWorkbook.Sheets(1) Wl.Copy After:=Wb_extraction Workbooks(fic).Close SaveChanges:=False ' Fermeture du classeur puis suppression de celui-ci Kill Workbooks(fic) nbc = nbc + 1 End If fic = Dir(rep) 'j' ai tout essayé Dir() ou Dir ça ne fonctionne pas Wend End sub
Merci beaucoup d'avance et bonne soirée !
Partager