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



A voir également:

4 réponses

Réponse 1 / 4
gbinforme Messages postés 14946 Date d'inscription   Statut Contributeur Dernière intervention   4 724
 
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
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Salut gbinforme.
Je suis arrivé trop tard, à la même conclusion.
Bonne journée à toi.
0
Réponse 2 / 4
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
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
Réponse 3 / 4
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
Réponse 4 / 4
Manouchk
 
Ma question est maintenant élucidée! Merci pour votre aide
0