Programme VBA report d'informations de plusieurs fichiers

Bonjour à tous !

Je voulais savoir s'il était possible de faire une macro qui pourrait me permettre de reporter d'une manière synthétique plusieurs informations contenues dans plusieurs fichiers Excel d'un même dossier Windows (Par exemple chemin = "C:\ANALYSEXLS\". Les fichiers en question sont identiques (voir modèle ci-joint comptamodele).

Concrètement je souhaiterais que la Macro m'affiche sur un fichier Excel d'une manière linéaire et synthétiques avec une ligne par ficher les éléments suivants :

Numéro de dossier : Cellule B3

Nom de dossier : Cellule B2

Nombre de cellules (non vides) : Plage de Cellule AM8 : AM19

Je ne sais pas si cela est réalisable j'aimerais voir un exemple ça m'aiderait considérablement dans ma compréhension du langage VBA.

Je vous remercie infiniment de votre aide.

8comptamodele.zip (148.46 Ko)

Bonsoir Liod, bonsoir le forum,

Dans un fichier vierge, copie/colle la macro ci-dessous dans un module standard et enregistre. Lance la macro...

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

Set CD = ThisWorkbook 'définit le classeur destination (ce classeur)
Set OD = CD.Worksheets(1) 'définit le'onglet destination OD (le premier onglet de ce classeur)
CA = "C:\ANALYSEXLS\" 'définit le chenim d'accès CA
'CA = CD.Path & "\" 'ou définit le chenim d'accès CA (celui où se trouve se classeur)
F = Dir(CA & "*.xls") 'définit le premier fichier F d'entension xls ayant CA comme chemin d'accès
Do While F <> "" 'exécute tant qu'il exite des fichier F
    If Not F = CD.Name Then 'condition : si le nom du fichier F est différent du nom de ce classeur
        Set CS = Workbooks.Open(CA & F) 'définit le classeur source CS en l'ouvrant
        Set OS = CS.Worksheets("COMPTE1") 'définit l'onglet source OS
        'définit la cellule de destination DEST (première cellule vide de la colonne A de l'onglet OD)
        Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row.Offset(1, 0)
        DEST.Value = OS.Range("B3").Value 'renvoie B3 de OS dans DEST
        DEST.Offset(0, 1).Value = OS.Range("D2").Value 'renvoie D2 de l'onglet OS dans dest décalée d'une cellule a droite
        'renvoie le nombre de cellule vides de la plage AM8:A819 de l'onglet OS dans DEST décalée de deux cellules à droite
        DEST.Offset(0, 2).Value = Application.WorksheetFunction.CountBlank(OS.Range("AM8:AM19"))
        CS.Close False 'ferme le classeur source sans renregistrer
        F = Dir 'définit le prochain fichier F d'extension xls ayant CA comme chemin d'accès
    End If 'fin de la condition
Loop 'boucle
End Sub

Si tu veux qu'elle agisse sur tous les fichiers qui se trouvent dans le même dossier que le fichier source, commente la première ligne CA et dé commente la seconde...

Merci pour ce magnifique travail qui est très détaillé avec les explications pour chaque ligne de la macro. J'arrive en partie à comprendre le raisonnement et ça va beaucoup m'aider.

Cependant j'ai une erreur d'exécution '424' Objet requis apriori ça bloque sur cette ligne :

Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row.Offset(1, 0)

Je ne comprends pas trop dois-je définir la cellule de destination ?

Re,


Désolé Liod, c'est de ma faute. Remplace cette ligne par :

Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)

Il y avait ".Row "en trop.

Bonsoir,

Un grand merci la macro fonctionne parfaitement bien avec cette nouvelle modification.

Je te remercie infiniment pour tes explications à chaque ligne c'est super.

Rechercher des sujets similaires à "programme vba report informations fichiers"