Discussion :

[WCastillo]

Bonjour Chère communauté
je réalise actuellement un stage dans une société.
il m'as été accordé la tache de:
Élaborer une Macro qui permettrai de récupérer la cellule B4 sur Plusieurs fichiers .xlsx (2000) contenus dans un seul Dossier vers un nouveau classeur
je suis vraiment pas débutant sur de la programmation
(il me faut un bon temps d'analyse pour comprendre la logique du code)

en cherchant sur internet j'ai trouvé des bouts de code sur mon sujet
à présent j'arrive à ouvrir le classeur récepteur et un des fichier, avec un boucle, d'où on copie la cellule B4

mais j'ai une erreur sur la ligne qui copie la cellule
je vous met une capture de mon code

pourriez vous m'aider S'il vous plait
je vous remercie d'avance et peut mieux développer si je me suis pas bien fait comprendre

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
Option Explicit
Sub Macro1()
    Dim FSO  As Object
    Dim file_fichierNT As Object
 
     ' // Quelques variables
    Dim wb_maitre    As Workbook
    Dim wb_fichierNT    As Workbook
 
    Dim cells As Integer
    '//cells = Workbooks(Selection.Value).Sheets(Selection.Value).Range("B4").Value
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    '// declare une variable pour la cellule A1
 
 
    Set wb_maitre = Workbooks.Open("C:\Users\usertests\Documents\macro_excel\maitre\maitre.xlsx") ' // On ouvre le classeur maître
 
 
    For Each file_fichierNT In FSO.GetFolder("C:\Users\usertests\Documents\macro_excel\").Files
 
        ' // On vérifie a priori que le fichier est un classeur (XLS)
        If UCase(file_fichierNT.Name) Like "*.XLSX" Then
 
            Set wb_fichierNT = Workbooks.Open(file_fichierNT.Path, ReadOnly:=True)
 
            file_fichierNT.Worksheets("1").Activate.range("B4").Select.Copy After:=file_fichierNT
 
 
            ' // On ferme le classeur quesTP, sans rien enregistrer - euh, à quoi sert le readonly alors ???
            wb_fichierNT.Close SaveChanges:=False
 
 
        End If
       Next
 
End Sub

Mercie de nouveau
cordialement Wcastillo

[Thautheme]

Bonjour WCastillo, bonjour le forum,

Au niveau de la copie le code que tu utilises est erroné tu as mélangé, il me semble, la copie d'un onglet et celle d'une cellule. Le code que je te propose utilise une autre méthode pour l'ouverture des fichiers mais surtout il copie le cellule B4 de chaque fichier dans la colonne A (tu adapteras si nécessaire) du classeur Maître. Ce code, d'ailleurs, est à placer dans ce classeur maître :

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
Sub Macro1()
Dim CM As Workbook 'déclare la variable CM (Classeur Maître)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim F As String 'déclare la variable F (Fichier)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
 
Set CM = ThisWorkbook 'définit le classeur maître CM
CA = "C:\Users\usertests\Documents\macro_excel\" 'définit le chemin d'accès CA
F = Dir(CA & "*.xlsx") 'définit le premier fichier F du chemin d'accès CA ayant une extension .xlsx
Do While F <> "" 'exécute tant qu'il existe des fichiers
    'condition : si A1 de l'onglet 1 du classeur maître CM est vide
    If CM.Sheets(1).Range("A1").Value = "" Then 'définit la cellule de destination DEST : A1
        Set DEST = CM.Sheets(1).Range("A1")
    Else 'sinon
        'définit la cellule de destination : la première cellule vide de la colonne A de l'onglet 1 du classeur CM
        Set DEST = CM.Sheets(1).Range("A" & Application.Rows.Count).End(xlUp).Offset(1, 0)
    End If 'fin de la condition
    Workbooks.Open (CA & F) 'ouvre le fichier F
    Set CS = ActiveWorkbook 'définit le classeur source CS
    CS.Sheets(1).Range("B4").Copy DEST 'copie la cellule B4 de l'onglet 1 du classeur source et la copie dans DEST
    CS.Close False 'ferme le classeur source sans enregistrer
    F = Dir 'définit le prochain fichier du chemin d'accès CA ayant une extension .xlsx
Loop 'boucle
End Sub

[patricktoulon]

bonsoir
teste ca

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub test()
    Dim CA$, cel As Range, Fichiers, Feuille$
    CA = "C:\Users\usertests\Documents\macro_excel"
    Feuille = "Feuil1"'adapter le nom de la feuille des fichiers
    Fichiers = Dir(CA & "\*.xlsx")
    Do While Fichiers <> ""
        With Sheets(1)
            If .Range("A1").Value = "" Then Set cel = .Range("A1") Else Set cel = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
            cel.Value = ExecuteExcel4Macro("'" & CA & "\[" & Fichiers & "]" & Feuille & "'!" & "R4C2")
        End With
        Fichiers = Dir
    Loop
End Sub