VBA Excel Problème de boucle sur fichiers

Résolu
Manouchk -  
 Manouchk -
Bonjour,

Voilà, je cherche à écrire une boucle me permettant de copier des cellules de sous fichiers dans une nouvelle feuille.

Un fenêtre me signal lors de Workbooks.open Chemin, que mon Fichier "P1C1-1.xlsx" est introuvable et pourtant il se trouve bien à cet emplacement.
Quelqu'un a t il déjà connu ce problème?

Merci Par avance!!

Sub CreationSynthese()
Cells.Delete

Dim Chemin As String, Fichier As String
Chemin = Dir("K:\Stagiaire\Stagiaire9\Essais_grappes\Placette_1\Pied1\*.xlsx")
While Len(Chemin) > 0
Workbooks.Open Chemin
AvantDernièreLigne = ActiveSheet.UsedRange.Rows.Count - 1
Range("B2:GS253" & AvantDerniereLigne).Copy
Workbooks("Récap_P1C1.xlsm").Activate
DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
Range("B2:GS" & ActiveSheet.UsedRange.Rows.Count).Select
ActiveSheet.Paste
Range("A" & DebutNomFichier & ":A" & ActiveSheet.UsedRange.Rows.Count) = Chemin
Workbooks(Chemin).Close

Chemin = Dir
Wend

4 réponses

  1. gbinforme Messages postés 14930 Date d'inscription   Statut Contributeur Dernière intervention   4 744
     
    Bonjour,

    Ce que tu appelles "Chemin" n'est en fait que ton nom de fichier et donc tu ne vas pas le trouver : il faut que tu mettes ton répertoire dans une variable et en précéder ton fichier pour que cela fonctionne.

    Dim rep As String
    rep= "K:\Stagiaire\Stagiaire9\Essais_grappes\Placette_1\Pied1\"
    puis
    Workbooks.Open rep & Chemin

    Si tu avais exécuté ton code en pas à pas (F8) tu aurais vu toi même le problème !
    Toujours zen
    La perfection est atteinte, non pas lorsqu'il n'y a plus rien à ajouter, mais lorsqu'il n'y a plus rien à retirer. Antoine de Saint-Exupéry
    0
    1. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Salut gbinforme.
      Je suis arrivé trop tard, à la même conclusion.
      Bonne journée à toi.
      0
  2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bonjour,

    2crit comme ça, ton code affecte, à la variable Chemin, le nom du fichier. Or, pour ouvrir un fichier sans problème, il faut lui donner : le chemin d'accès et le nom du fichier.
    Essaye comme ceci :

    Dim Chemin As String, Fichier As String
    
    Cells.Delete
    Chemin = "K:\Stagiaire\Stagiaire9\Essais_grappes\Placette_1\Pied1\*.xlsx"
    Fichier = Dir("K:\Stagiaire\Stagiaire9\Essais_grappes\Placette_1\Pied1\*.xlsx")
    While Len(Fichier) > 0
        Workbooks.Open Chemin & Fichier
        AvantDernièreLigne = ActiveSheet.UsedRange.Rows.Count - 1
        Range("B2:GS" & AvantDerniereLigne).Copy
        Workbooks("Récap_P1C1.xlsm").Activate
        DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
        Range("B2:GS" & ActiveSheet.UsedRange.Rows.Count).Select
        ActiveSheet.Paste
        Range("A" & DebutNomFichier & ":A" & ActiveSheet.UsedRange.Rows.Count) = Fichier
        Workbooks(Chemin).Close
        Fichier = Dir
    Wend

    0
  3. Manouchk
     
    Merci beaucoup! J'arrive maintenant à un bon résultat..
    Cependant, le tableau du premier fichier se colle seulement à la deuxième ligne et non pas à la première et le début des autres se collent sur la dernière ligne du précédent.
    Comment doit-on faire pour sur tous les tableaux, qui contiennent 253 lignes, se collent bien les uns après les autres?
    Merci d'avance!!!

    Sub CreationSynthese()
    Cells.Delete

    Dim Chemin As String, Fichier As String

    Chemin = "K:\Stagiaire\Stagiaire9\Essais_grappes\Placette_1\Pied1\"
    Fichier = Dir("K:\Stagiaire\Stagiaire9\Essais_grappes\Placette_1\Pied1\*.xlsx")
    While Len(Fichier) > 0
    Workbooks.Open Chemin & Fichier
    AvantDernièreLigne = ActiveSheet.UsedRange.Rows.Count - 1
    Range("B2:GS253" & AvantDerniereLigne).Copy
    Workbooks("Récap_P1C1.xlsm").Activate
    DebutNomFichier = ActiveSheet.UsedRange.Rows.Count + 1
    Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select
    ActiveSheet.Paste
    Workbooks(Fichier).Close
    Fichier = Dir
    Wend
    0
  4. Manouchk
     
    Ma question est maintenant élucidée! Merci pour votre aide
    0