Extraire des données dans des fichiers fermés (Problème avec "Resize")

[BChaly]

Bonsoir à tous,

Avec le code suivant (Voir fichier "Recap"), je souhaite extraire des données provenant de plusieurs
fichiers fermés "Stat1" et "Stat2".

En commençant par la ligne 2 (du fichier "Recap"), j'aimerais afficher les données ligne par ligne.

Ceci semble presque fonctionner, mais seules les données du dernier fichier figurant dans le dossier
"DATA" sont prises en compte.

Peut-être s'agit-il de la ligne avec "Resize"?

Je vous remercie pour votre aide.

Cordialement

BChaly

Option Explicit
Sub CopyData()

Dim RowX As Integer
Dim Path As String, FileName As String

Application.EnableEvents = False
Application.ScreenUpdating = False

RowX = 2
Path = "C:\Documents and Settings\XXX\Desktop\DATA\"

FileName = Dir(Path & "*.xls")
    While FileName <> ""
        If FileName <> ThisWorkbook.Name Then
            With Workbooks.Open(Path & FileName)
                With .Sheets("Sheet1").Range("A1:H1")
                    ThisWorkbook.Sheets("Sheet1").Range("a" & Rows.Count).End(xlUp)(2) _
                    .Resize(.Rows.Count, .Columns.Count).Value = .Value
                End With
                    .Close False
            End With
        End If
FileName = Dir
Wend

Application.EnableEvents = True
Application.ScreenUpdating = True
    
End Sub

 

[Compte Supprimé 979]

Re : Extraire des données dans des fichiers fermés (Problème avec "Resize")

Bonsoir BCharly,

Ton problème n'est pas dû au resize mais au calcul de la nouvelle ligne pour inscrire les données.

En effet le calcul est effectué sur la colonne A, hors dans ton exemple, il n'y a rien dans cette colonne !
Les résultats viennent donc ce mettre toujours au même endroit, ligne 2 😉

Voici le bon code avec un peu de commentaires

Sub CopyData()
  Dim NLig As Long, ShtD As Worksheet
  Dim Path As String, FileName As String
  ' Empècher les évènements de s'activer
  Application.EnableEvents = False
  ' Empècher le rafraichissement écran
  Application.ScreenUpdating = False
  ' Définir la feuille 1 du classeur actuel comme celle de destination
  Set ShtD = ThisWorkbook.Sheets(1)
  ' Définir le chemin d'accès aux fichiers
  Path = "C:\Documents and Settings\XXX\Desktop\DATA\"
  ' Effectuer la directory du répertoire
  FileName = Dir(Path & "*.xls")
  ' Avec le fichier trouvé
  While FileName <> ""
    ' Si le nom est différend de celui de ce classeur
    If FileName <> ThisWorkbook.Name Then
      ' Ouvrir le fichier en question
      With Workbooks.Open(Path & FileName)
        ' Avec les cellules définies de la feuilles 1
        With .Sheets("Sheet1").Range("A1:H1")
          ' Prochaine ligne vide de la feuille 1 de ce classeur
          NLig = ShtD.Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Row
          ' Remplir la nouvelle ligne de la feuille 1 de ce classeur
          ShtD.Range("A" & NLig).Resize(.Rows.Count, .Columns.Count).Value = .Value
        End With
        .Close False
      End With
    End If
    FileName = Dir
  Wend
  ' Vider la variable mémoire
  Set ShtD = Nothing
  ' Activer les évènements
  Application.EnableEvents = True
  ' Activer le rafraichissement
  Application.ScreenUpdating = True
End Sub

A+

 

[BChaly]

Re : Extraire des données dans des fichiers fermés (Problème avec "Resize")

Bonjour Bruno,

Génial, ça fonctionne parfaitement!!!

De plus, j'apprécie beaucoup les commentaires qui sont très utiles pour comprendre le code.

Immense MERCI pour votre aide.

Cordialement,

BChaly