Récupération de données de fichiers fermés

[grotsblues]

Bonjour
Je cherche à récupérer des données de plusieurs fichiers fermés dans une récap, en reprenant le nom du fichier ainsi que les données en A2: D10
Celles-ci proviennent soit d'une liste déroulante, soit de texte libre et il est possible d'avoir une ligne vide.
Je suis novice en VBA et essaie d'adapter vos exemples à mon besoin.
A l'ouverture du fichier recap, j'ai bien le nom du fichier ainsi que la première ligne mais n'arrive pas à obtenir les autres lignes.
Quelqu'un pourrait-il m'aider à obtenir le résultat souhaité (recap G2:K…) ?
Merci de votre aide.
grotsblues

 

[Lolote83]

Re : Récupération de données de fichiers fermés

Salut Grotsblues,
Tu trouveras en fichier joint seulement le récap modifié.
Dans le module Mod_LireFerme, tu as le code pour lire un fichier fermé.
A adapter à tes besoins.
@+ Lolote83

 

[job75]

Re : Récupération de données de fichiers fermés

Bonjour grotsblues,

Pour tester téléchargez les fichiers joints dans le même répertoire (par exemple le bureau).

La macro :

Sub Copie()
Dim chemin$, nomfeuil$, h&, ncol%, a$, lig&, nomfichier$, f$, P As Range
chemin = ThisWorkbook.Path & "\"
nomfeuil = "Feuil1" 'nom commun des feuilles sources
h = 1000 'nombre maximum de lignes des tableaux sources, à adapter
ncol = 4 'nombre de colonnes des tableaux sources, à adapter
Application.ScreenUpdating = False 'fige l'écran
With Feuil1 'CodeName de la feuille de destination
  .Range("A2:A" & .Rows.Count).Resize(, ncol + 1).ClearContents 'RAZ
  a = .[A2].Resize(h, ncol).Address(ReferenceStyle:=xlR1C1)
  lig = 2 'restitution à partir de la ligne 2 (titres en ligne 1)
  nomfichier = Dir(chemin & "*.xls*") '1er fichier du dossier
  While nomfichier <> ""
    If nomfichier <> ThisWorkbook.Name Then
      .Cells(lig, 1).Resize(h) = nomfichier
      f = "='" & chemin & "[" & nomfichier & "]" & nomfeuil & "'!" & a
      .Cells(lig, 2).Resize(h, ncol).FormulaArray = f 'formule matricielle
      lig = lig + h
    End If
    nomfichier = Dir 'fichier suivant du dossier
  Wend
  .[A2].Resize(lig, ncol + 1) = .[A2].Resize(lig, ncol + 1).Value 'supprime les formules
  With .[B2].Resize(lig)
    .Replace 0, "", xlWhole 'efface les zéros
    On Error Resume Next 'si aucune cellule vide en colonne B
    Set P = .SpecialCells(xlCellTypeBlanks)
    Intersect(P.EntireRow, .Offset(, -1).Resize(, ncol + 1)).Delete xlUp
  End With
  Set P = .UsedRange 'actualise la barre de défilement verticale
End With
End Sub

Nota : les fichiers sources peuvent être des fichiers .xlsx ou .xls

Edit 1 : salut Lolote83.

Edit 2 : j'ai utilisé dans les formules la notation R1C1 pour pouvoir faire d'autres essais.

On peut utiliser aussi bien la notation A1 avec a = .[A2].Resize(h, ncol).Address

A+