Bonjour,
J'ai créé un compilateur en arrangeant un code trouvé sur internet selon mon besoin.
Ce compilateur doit me permettre, indépendamment du format des tableaux à compiler (qui ont tous la même forme selon le type de données), de copier les valeurs de tableaux contenus dans différents classeurs afin de les assembler dans un nouveau classeur.
Oui mais voilà, étant novice en VBA, mon code fonctionne mal, et j'ai du mal à trouver les erreurs dans le code.
Je rencontre deux problèmes :
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 Sub Regrouper_Fichiers() Dim fso As Object 'Système de fichiers Dim rep As Object 'Répertoire Dim cfr As Object 'Collection de fichiers du répertoire Dim fic As Object 'Fichier (élément de la collection cfr) Dim wbk As Workbook 'Classeur Dim res As Workbook 'Classeur resultat Dim rng As Range 'Plage de cellules Dim dst As Range 'Cellule de destination Dim pth As String 'Chemin du répertoire Dim i As Integer ' Définir le répertoire à lire pth = "C:\Users\Herkabe\Desktop\Reporting WC\Flux Achats-Ventes" ' Créer le fichier résultat Set res = Workbooks.Add(xlWBATWorksheet) Set dst = res.Worksheets(1).Range("A1") ' Lecture du répertoire Set fso = CreateObject("Scripting.FileSystemObject") Set rep = fso.GetFolder(pth) Set cfr = rep.Files ' Contrôler chaque fichier du répertoire For Each fic In cfr ' - Vérifier s'il s'agit d'un fichier Excel... If StrComp(fso.GetExtensionName(fic.Name), "xls", vbTextCompare) = 0 Then ' ... dans l'affirmative, ouvrir le fichier et mettre à jour les liaisons Set wbk = Workbooks.Open(Filename:=pth & "\" & fic.Name, UpdateLinks:=xlUpdateLinksAlways) ' Compte le nombre de colonnes à copier dercol = Cells(6, Columns.Count).End(xlToLeft).Column ' Copie les colonnes une par une For i = 1 To dercol Step 1 ' Copier la colonne Set rng = wbk.Worksheets(1).UsedRange rng.Copy dst Next ' Fermer le fichier sans le modifier wbk.Close False ' Destination suivante With res.Worksheets(1) Set dst = .Cells(.Rows.Count, "A").End(xlUp).Offset(1) End With End If Next fic End Sub
-Après avoir copié un tableau correctement, la macro copie seulement les en-tête des tableaux suivants et les colle après l'en-tête du premier tableau, sur les données!
-Le deuxième problème vous l'aurez compris, la macro copie les en-tête de tous les tableaux alors que ce n'est pas nécessaire. Comme ils ont tous la même en-tête, la copier une seule fois suffit...
Je m'en remets à vous. Au plaisir de vous lire. Merci.
Partager