XL 2013 Nombre de lignes de classeurs fermés

[sr94]

Bonjour,


Je souhaiterais récupérer, à partir d’un classeur ouvert, le nombre de lignes de tous les classeurs existants et qui sont fermés dans un autre répertoire. Tous les classeurs ont 1 seule feuille avec un tableau nommé (toujours le même) et ont la même structure.

Idéalement dans mon fichier ouvert j’aimerais dans une feuille dédiée récupérer le nom de l’utilisateur de l’ordinateur / la date et l’heure / le nom du fichier / le nombre de lignes du Tableau et pouvoir cumuler ces lignes à chaque fois que la macro est lancée.

Avez-vous une idée pour ce code ?


Merci beaucoup

 

[job75]

Bonjour sr94,

Voyez cette macro dans le fichier Bilan.xlsm :

Sub Bilan()
Dim Dossier$, NomTableau$, Fichier$, lig&
Dossier = ThisWorkbook.Path & "\MonDossier\" 'à adapter
NomTableau = "Tableau" 'à adapter
Fichier = Dir(Dossier & "*.xlsx") '1er fichier du dossier
lig = Application.CountA([A:A])
While Fichier <> ""
    lig = lig + 1
    Cells(lig, 1) = Environ("UserName")
    Cells(lig, 2) = Now
    Cells(lig, 3) = Fichier
    Cells(lig, 4) = "=ROWS('" & Dossier & Fichier & "'!" & NomTableau & ")"
    Cells(lig, 4) = Cells(lig, 4).Value
    Fichier = Dir
Wend
End Sub

Téléchargez le fichier Bilan.xlsm et le sous-dossier MonDossier dans le même répertoire (le bureau).

A+

 

[job75]

Re,

Il faut noter que la solution précédente ne fonctionne pas sur des tableaux définis dynamiquement par la formule :

=DECALER(Feuil1!$A$1;;;NBVAL(Feuil1!$A:$A);3)

On utilisera alors cette autre macro :

Sub Bilan()
Dim Dossier$, NomFeuille$, Fichier$, lig&
Dossier = ThisWorkbook.Path & "\MonDossier\" 'à adapter
NomFeuille = "Feuil1" 'à adapter
Fichier = Dir(Dossier & "*.xlsx") '1er fichier du dossier
lig = Application.CountA([A:A])
While Fichier <> ""
    lig = lig + 1
    Cells(lig, 1) = Environ("UserName")
    Cells(lig, 2) = Now
    Cells(lig, 3) = Fichier
    Cells(lig, 4) = "=COUNTA('" & Dossier & "[" & Fichier & "]" & NomFeuille & "'!A:A)"
    Cells(lig, 4) = Cells(lig, 4).Value
    Fichier = Dir
Wend
End Sub

Fichier (2).

A+

 

[sr94]

C'est parfait avec la 2e macro merci beaucoup !

 

[job75]

Bonjour sr94, le forum,

S'il peut y avoir des lignes vides dans les tableaux sources il faut une macro plus compliquée :

Sub Bilan()
Dim Dossier$, NomFeuille$, Fichier$, lig&, v1 As Variant, v2 As Variant
Dossier = ThisWorkbook.Path & "\MonDossier\" 'à adapter
NomFeuille = "Feuil1" 'à adapter
Fichier = Dir(Dossier & "*.xlsx") '1er fichier du dossier
lig = Application.CountA([A:A])
Application.ScreenUpdating = False
While Fichier <> ""
    lig = lig + 1
    Cells(lig, 1) = Environ("UserName")
    Cells(lig, 2) = Now
    Cells(lig, 3) = Fichier
    v1 = ExecuteExcel4Macro("MATCH(""zzz"",'" & Dossier & "[" & Fichier & "]" & NomFeuille & "'!C1)")
    If IsError(v1) Then v1 = 0
    v2 = ExecuteExcel4Macro("MATCH(9^99,'" & Dossier & "[" & Fichier & "]" & NomFeuille & "'!C1)")
    If IsError(v2) Then v2 = 0
    Cells(lig, 4) = IIf(v1 > v2, v1, v2)
    Fichier = Dir
Wend
End Sub

Fichier (3).

Bonne journée.