Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Candidat au Club
    Homme Profil pro
    Etudiant
    Inscrit en
    janvier 2019
    Messages
    1
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 25
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : Etudiant
    Secteur : High Tech - Opérateur de télécommunications

    Informations forums :
    Inscription : janvier 2019
    Messages : 1
    Points : 2
    Points
    2

    Par défaut Macro pour récupérer la cellule B4 sur Plusieurs fichiers .xlsx vers un nouveau classeur

    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

  2. #2
    Membre chevronné Avatar de Thautheme
    Homme Profil pro
    salarié
    Inscrit en
    août 2014
    Messages
    1 059
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 58
    Localisation : France, Hérault (Languedoc Roussillon)

    Informations professionnelles :
    Activité : salarié

    Informations forums :
    Inscription : août 2014
    Messages : 1 059
    Points : 1 976
    Points
    1 976

    Par défaut

    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
    À plus,

    Thauthème

    Je suis Charlie

  3. #3
    Débutant  
    Avatar de patricktoulon
    Homme Profil pro
    cuisiniste
    Inscrit en
    avril 2009
    Messages
    15 114
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Var (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : cuisiniste
    Secteur : Bâtiment

    Informations forums :
    Inscription : avril 2009
    Messages : 15 114
    Points : 12 887
    Points
    12 887
    Billets dans le blog
    6

    Par défaut re

    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
    mes fichiers dans les contributions:
    mail avec CDO en vba et mail avec CDO en vbs dans un HTA
    survol des bouton dans userform
    prendre un cliché d'un range

    si ton problème est résolu n'oublie pas de pointer : : ça peut servir aux autres
    et n'oublie pas de voter

Discussions similaires

  1. Réponses: 2
    Dernier message: 11/11/2018, 18h29
  2. Réponses: 1
    Dernier message: 15/06/2017, 16h14
  3. Macro pour glissade d'un tableau sur plusieurs feuilles
    Par Jack Ilo dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 07/05/2017, 09h02
  4. Macro pour masquer des lignes vides sur plusieurs feuillés.
    Par baloote69 dans le forum Macros et VBA Excel
    Réponses: 12
    Dernier message: 03/11/2015, 11h38
  5. [XL-2013] Macro de création de TCD utilisable sur plusieurs fichiers
    Par VictorienR dans le forum Macros et VBA Excel
    Réponses: 7
    Dernier message: 13/05/2015, 20h20

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo