Synthèse

Le 12/07/2017 à 20:16

Bonjour à tous,

Débutant en VBA, j'aurai besoin de votre aide pour construire mon projet.

J'ai au sein d'un répertoire défini, l'accumulation d'un nombre croissant de fichier xlsm correspondant à des demandes de transport.

J'aimerai exécuter une macro me permettant l'ouverture et la fermeture de ces fichiers afin qu'il me copie les cellules renseignées (exemple B29) dans un tableau (différent) récapitulatif dans un nouveau classeur (Coller en A17 dans le nouveau). J'aimerai que toutes mes données de B29 (sur l'ensemble de mes fichiers) se répertorie les un en dessous des autres à partir donc de A17 sur mon nouveau classeur.

Est ce possible ?

Si oui par quel code ?

Merci d'avance d'un novice en quête d'apprendre le VBA !

Le 12/07/2017 à 23:16

Bonsoir Sbstn, bonsoir le forum,

Le code ci-dessous et à placer dans le fichier Destination (qui va recevoir les données) et lui-même doit se trouver dans le même dossier que les fichiers source. Il te faudra éventuellement adapter le nom des onglets (destination et source). Le code utilise le premier onglet de chaque classeur (destination et source) :

Sub Macro1()
Dim CD As Workbook 'déclare le variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare le variable OD (Onglet Destination)
Dim CA As String 'déclare le variable CA (Chemin d'Accès)
Dim F As String 'déclare le variable F (Fichier)
Dim CS As Workbook 'déclare le variable CS (Classeur Source)
Dim OS As Worksheet 'déclare le variable OS (Onglet Source)
Dim DEST As Range 'déclare le variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD (tu adapteras à ton cas, ici j'ai pris le premier onglet du classeur destination CD)
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(CA & "*.xlsx") 'définit le premier fichier Excel du dossier ayant CA comme chemin d'accès (extension à adapter à ton cas)
Do While F <> "" 'exécute tant qu'il y a des fichiers F
    If F.Name <> CD.Name Then 'condition : si le fichier F n;'est pas le classeru destination
        Workbooks.Open CA & F 'ouvre le fichier F
        Set CS = ActiveWorkbook 'définit la classeur source CS
        Set OS = CS.Worksheets(1) 'définit l'ongelt source CS (à adapter à ton cas)
        'définit la cellule de destination DEST (A17 si A17 est vide, sinon la première cellule vide de la colonne A de l'onglet OD)
        Set DEST = IIf(OD.Range("A17").Value = "", OD.Range("A17"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))
        DEST.Value = OS.Range("B29") 'copie sans les format d'origine (tu supprimeras la ligne qui ne te convient pas)
        OS.Range("B29").Copy DEST 'copie avec les formats d'origine (tu supprimeras la ligne qui ne te convient pas)
        CS.Close SaveChanges:=True 'ferme le classeur source (sans enregistrer)
    End If 'fin de la condition
    F = Dir 'définit le prochain fichier excel F du dossier ayant CA comme chemin d'accès
Loop 'boucle
End Sub
Le 13/07/2017 à 00:20

Bonjour à tous,

voici un exemple utilisant ExecuteExcel4Macro, donc sans ouvrir les fichiers,

Sub lireFichiers()
    'Nécessite d'activer la référence Microsoft Shell Controls and Automation
    Dim objShell As Shell32.Shell
    Dim strFileName As Shell32.FolderItem
    Dim objFolder As Shell32.Folder
    Dim rep As String, vSheet As String, rng As String, x As Integer

    rep = "C:\Users\xxx\Documents\"
    vSheet = "Feuil1"
    rng = Range("B29").Address(, , xlR1C1)
    x = 17

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(rep)

    For Each strFileName In objFolder.Items
     If strFileName.isFolder = False Then
        Range("A" & x) = ExecuteExcel4Macro("'" & rep & "[" & strFileName & "]" & vSheet & "'!" & rng)
     End If
     x = x + 1
    Next
End Sub
Le 13/07/2017 à 11:53

Bonjour,

D'abord merci de vos réponses.

Cependant je n'arrive pas à faire fonctionner la macro ...

Je vous joint pour ce faire mes deux fichiers l'un étant répétitif (camionette taxi), l'autre étant mon tableau de synthèse (test_list2).

D'avance merci

8camionette-taxi-ambulance-20f1r7.xlsm (43.13 Ko)
8test-list2.xlsm (24.25 Ko)
Le 13/07/2017 à 12:15

Re,

Je ne comprends pas !... Tu as modifié le code proposé (remplacé F pas Fichier dans le Do While, supprimé les lignes qui définissaient le classeur destination et l'onglet destination) et maintenant tu viens dire que ça marche pas !...

En plus tu fournis un fichier verrouillé par mot de passe où l'accès à la cellule B29 n'est pas permis !...

Le code est, il me semble, suffisamment commenté pour t'éviter de faire n'importe quoi !...

Le 13/07/2017 à 12:28

Re,

Désolé si je vous ai offensé, loin de moi cette idée.

Le code bloque à la ligne "If F.Name <>..." avec comme consigne : "Qualificateur incorrect" et c'est pour cela que j'ai essayé (surement une mauvaise idée) de le bidouillé.

Je vous rejoint le fichier avec le code originel..

Encore désolé et merci

9test-list2.xlsm (23.72 Ko)
Le 13/07/2017 à 13:39

Re,

sbstn a écrit :

je n'arrive pas à faire fonctionner la macro ...

Essaie d'être plus explicite !... Qu'est-ce qui ne vas pas ? Qu'est-ce qui ne fonctionne pas ?...

Le 13/07/2017 à 13:47

La macro bloque sur cette ligne et semble ne pas accepter le F.Name.

Si j'efface le ".name" elle passe mais bloque sur le chemin d'accès ....

Un print screen sera plus parlant

11file-name.pdf (154.17 Ko)
6file-sans-name.pdf (146.47 Ko)
Le 13/07/2017 à 17:11

Re,

Tu as raison il y a bien une erreur dans le code. le voici corrigé :

Sub Macro1()
Dim CD As Workbook 'déclare le variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare le variable OD (Onglet Destination)
Dim CA As String 'déclare le variable CA (Chemin d'Accès)
Dim F As String 'déclare le variable F (Fichier)
Dim CS As Workbook 'déclare le variable CS (Classeur Source)
Dim OS As Worksheet 'déclare le variable OS (Onglet Source)
Dim DEST As Range 'déclare le variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD (tu adapteras à ton cas, ici j'ai pris le premier onglet du classeur destination CD)
'CA = "C:\Users\infirmiereco\Desktop\Test\" 'saisir le chemin complet du dossier où se trouvent les fichiers
CA = CD.Path & "\" 'définit le chemin d'accès CA
F = Dir(CA & "*.xlsm") 'définit le premier fichier Excel du dossier ayant CA comme chemin d'accès (extension à adapter à ton cas)
Do While F <> "" 'exécute tant qu'il y a des fichiers F
If F <> CD.Name Then 'condition : si le fichier F n;'est pas le classeru destination
    Workbooks.Open CA & F 'ouvre le fichier F
    Set CS = ActiveWorkbook 'définit la classeur source CS
    Set OS = CS.Worksheets(1) 'définit l'ongelt source CS (à adapter à ton cas)
    'définit la cellule de destination DEST (A17 si A17 est vide, sinon la première cellule vide de la colonne A de l'onglet OD)
    Set DEST = IIf(OD.Range("A17").Value = "", OD.Range("A17"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))
    DEST.Value = OS.Range("B29") 'copie sans les format d'origine (tu supprimeras la ligne qui ne te convient pas)
    OS.Range("B29").Copy DEST 'copie avec les formats d'origine (tu supprimeras la ligne qui ne te convient pas)
    CS.Close SaveChanges:=True 'ferme le classeur source (sans enregistrer)
End If 'fin de la condition
F = Dir 'définit le prochain fichier excel F du dossier ayant CA comme chemin d'accès
Loop 'boucle
End Sub
Rechercher des sujets similaires à "synthese"