Code VBA non fonctionnel

bonobovert Messages postés 5 Date d'inscription   Statut Membre Dernière intervention   -  
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,

je cherche à créer une unique feuille excel dans un nouveau classeur qui reprendrais les données de 200 classeurs excel semblables (1 seule feuille excel, 26 colonnes comportant les mêmes en-têtes mais un nombre de ligne variable selon le fournisseur). J'ai mis tous ces fichiers .xlsx dans un seul dossier à part : C:\Users\Documents\fournisseurs\

J'ai trouvé ce code VBA en fouillant sur internet mais il ne fonctionne pas ? Erreur 1004.
Quand je décompose, ça bloque à l'étape 7. Le 1er fichier s'ouvre, une copie est créée mais ça s'arrête là

1. Sub recup()
2. Range("A1").Select
3. Chemin = "C:\Users\Documents\fournisseurs\"
4. Fichier = Dir(Chemin & "*.xlsx")
5. Do While Fichier <> ""
6. Workbooks.Open Filename:=Chemin & Fichier
7. Range("acopier").Copy
8. ThisWorkbook.Activate
9. ActiveSheet.Paste
10. Windows(Fichier).Activate
11. Application.CutCopyMode = False
12. ActiveWorkbook.Close savechanges:=False
13. ThisWorkbook.Activate
14. Range("A65536").End(xlUp).Offset(1, 0).Select
15. Fichier = Dir ' Fichier suivant
16. Loop
17. End Sub

J'ajoute que j'ai quand même fini par ouvrir chaque dossier 1 par 1 pour définir à chaque fois la plage de donnée "acopier" citée à cette étape 7. WTF ?

Ce sont mes premiers pas dans cet univers. Je crois que j'aurai été plus rapide à copier/coller tout seul mais je m'acharne ! et compte sur vous maintenant …

Merci d'avance !
A voir également:

3 réponses

Réponse 1 / 3
M-12 Messages postés 1332 Date d'inscription   Statut Membre Dernière intervention   285
 
Bonjour,

Teste comme ceci, la variable Dl définie la dernière ligne de chaque classeur ouvert 
Option Explicit

 Sub recup()
  Dim Dl%, Chemin$, Fichier$
  Range("A1").Select
  Chemin = "C:\Users\Documents\fournisseurs\"
  Fichier = Dir(Chemin & "*.xlsx")
    Do While Fichier <> ""
      Workbooks.Open Filename:=Chemin & Fichier
      Dl = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
      Range("A1:A" & Dl).Copy 'Sélection de la cellule A2 à la cellule A et dernière ligne (à modifier suivant valeur à copier)
      ThisWorkbook.Activate
      ActiveSheet.Paste
      Windows(Fichier).Activate
      Application.CutCopyMode = False
      ActiveWorkbook.Close savechanges:=False
      ThisWorkbook.Activate
      Range("A65536").End(xlUp).Offset(1, 0).Select
      Fichier = Dir ' Fichier suivant
    Loop
 End Sub
1
bonobovert Messages postés 5 Date d'inscription   Statut Membre Dernière intervention  
 
Merci pour la réponse ! J'ai essayé. Le code tourne. Les fichiers s'ouvrent les uns après les autres, je vois que les zones sélectionnées semblent bonnes, mais il n'y a rien de collé dans mon fichier macro.

Je n'ai pas modifié la ligne 12, peut être est-ce là que le bas blesse : Range("A1:A" & Dl).Copy 'Sélection de la cellule A2 à la cellule A et dernière ligne (à modifier suivant valeur à copier) ?

Je fais des tests pour voir...
0
M-12 Messages postés 1332 Date d'inscription   Statut Membre Dernière intervention   285
 
Re,
Sans exemple devant mon nez, je ne peut deviner
0
bonobovert Messages postés 5 Date d'inscription   Statut Membre Dernière intervention  
 
Un grand merci M-12 ! Ca fonctionne en paramétrant cette ligne 12 à ma guise. Respect pour l'aide généreuse.
0
Réponse 2 / 3
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

Une facon de faire relativement simple. Sans les entetes, que vous devez avoir sur le classeur collecteur
nom de feuille classeur de donnees a adapter 
Sub recup()
    'Application.ScreenUpdating = False  'enlever le ' des que ok
    Chemin = "C:\Users\Documents\fournisseurs\"
    Fichier = Dir(Chemin & "*.xlsx")
    Do While Fichier <> ""
        Workbooks.Open Filename:=Chemin & Fichier
        TN_1 = Worksheets("feuil1").Range("A2:Z" & Range("A" & Rows.Count).End(xlUp).Row)       'mise en memoire
        Workbooks(Fichier).Close False
        Worksheets("feuil2").Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Resize(UBound(TN_1, 1), UBound(TN_1, 2)) = TN_1
      Fichier = Dir ' Fichier suivant
    Loop
    ThisWorkbook.Save
    Application.ScreenUpdating = True
End Sub


vu le nombre de fichiers (200), il faudrait plutot s'orienter vers une recuperation de donnees classeurs fermes
1
bonobovert Messages postés 5 Date d'inscription   Statut Membre Dernière intervention  
 
Merci pour l'aide ! J'ai utilisé le système d'M-12. Avec ce script, j'ai une erreur type 9 qui m'est signalée après la ligne 7. je vais faire des tests.
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,
Le nom de feuille....
0
Réponse 3 / 3
bonobovert Messages postés 5 Date d'inscription   Statut Membre Dernière intervention  
 
Si une âme charitable passe par ici… N'hésitez pas, il manque pas grand chose, je suis sur que pour quelqu'un d'expérimenté, c'est une affaire de minute...
0

Discussions similaires

sertissage des cables rj45
lekludo -
brupala -

7 réponses