Aide sur code VBA [Résolu/Fermé]

Signaler
Messages postés
8
Date d'inscription
lundi 16 janvier 2017
Statut
Membre
Dernière intervention
19 janvier 2017
-
Messages postés
8
Date d'inscription
lundi 16 janvier 2017
Statut
Membre
Dernière intervention
19 janvier 2017
-
Bonjour,

Tout d'abord, je débute sur VBA.
Je souhaite copier les cellules de plusieurs fichiers Excel appartenant à un même dossier dans un nouveau fichier Excel. Je suis aujourd'hui rendu à ce code mais avec une erreur 400.

Il semblerait que cela soit du à la plage car si je n'indique pas un terme mais le numéro d'une cellule, il déroule tout les fichiers du dossier (même si le fichier final reste vide)
J'ai nommé mes plages TOTO dans les fichiers Excels où je souhaite récupérer les valeurs

Voici le code:

Sub recup()
Range("A1").Select 'sélectionner la cellule de début
Chemin = "C:\Users\Adrien\OneDrive Entreprise 1\Travail\" 'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "*.xls") ' Premier fichier
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Range("TOTO").Copy
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

Merci beaucoup pour votre aide,

Adrien

7 réponses

Messages postés
1412
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
9 mars 2021
149
Bonjour Adrien, bonjour le forum,

Il est toujours préférable dans ce genre de cas de spécifier les classeurs et onglets source et destination. Essaie comme ça :

Sub recup()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.ActiveSheet 'définit l'onglet destination OD
Chemin = "C:\Users\Adrien\OneDrive Entreprise 1\Travail\" 'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "*.xls") ' Premier fichier
Do While Fichier <> ""
    Workbooks.Open Filename:=Chemin & Fichier
    Set CS = ActiveWorkbook 'définit le classeur source CS
    Set OS = CS.Worksheets(1) 'définit l'onglet source OS (à adaper)
    'définit la cellule de destination DEST (A1 si A1 est vide, sinon la première cellule vide de la colonne A de l'onglet destination OD)
    Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))
    OS.Range("TOTO").Copy DEST 'copy la plage nommée "TOTO" de l'onglet source dans DEST
    CS.Close savechanges:=False 'ferme le classeur source sans enregistrer
    Fichier = Dir ' Fichier suivant
Loop
End Sub

1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65492 internautes nous ont dit merci ce mois-ci

Messages postés
1412
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
9 mars 2021
149
Re,

Plutôt que nommer la plage dans chaque fichier, si ton tableau commence en A1, remplace :

OS.Range("TOTO").Copy DEST

par :
OS.Range("A1").CurrentRegion.Copy DEST 

1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 65492 internautes nous ont dit merci ce mois-ci

Messages postés
8
Date d'inscription
lundi 16 janvier 2017
Statut
Membre
Dernière intervention
19 janvier 2017

Merci beaucoup ThauTheme. Tu as réponse à tout et du premier coup !
Messages postés
8
Date d'inscription
lundi 16 janvier 2017
Statut
Membre
Dernière intervention
19 janvier 2017

Petit Précision je suis sur Office 2016
Messages postés
8
Date d'inscription
lundi 16 janvier 2017
Statut
Membre
Dernière intervention
19 janvier 2017

Ca marche! Merci beaucoup pour l'efficacité.

J'en profite pour te poser une question.
La plage en question concerne tout le fichier à chaque fois.
Je peux avoir 2 comme 15 fichiers par semaine. A chaque fois, je devrais nommer les plages de chaque fichier Excel.

- Est-ce possible de prendre tout le fichier sans nommer de plage sachant que les fichiers n'ont jamais le même nombre de ligne ?
- ou alors nommer automatiquement les plages via le code VBA?

Merci beaucoup!
Messages postés
8
Date d'inscription
lundi 16 janvier 2017
Statut
Membre
Dernière intervention
19 janvier 2017

Bonjour ThauTheme,

Je suis désolé de revenir vers toi mais il y a encore une petite erreur.
Je n'avais pas bien vu (car les lignes se ressemblent toute) mais le fichier final après macro ne comporte qu'un seul fichier de la liste.
La macro ouvre un fichier puis en prend un autre puis écrase le premier ainsi de suite.
Cela ne met pas à la suite .

Le code utilisé actuellement est :


Sub recup()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.ActiveSheet 'définit l'onglet destination OD
Chemin = "C:\Users\Adrien\OneDrive Entreprise 1\Travail\Demande Agence\" 'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "*.xls") ' Premier fichier
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Set CS = ActiveWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets(1) 'définit l'onglet source OS (à adaper)
'définit la cellule de destination DEST (A1 si A1 est vide, sinon la première cellule vide de la colonne A de l'onglet destination OD)
Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))
OS.Range("A1").CurrentRegion.Copy DEST 'copy la plage nommée "TOUT" de l'onglet source dans DEST
CS.Close savechanges:=False 'ferme le classeur source sans enregistrer
Fichier = Dir ' Fichier suivant
Loop
End Sub

Merci beaucoup pour ton aide,

Adrien
Messages postés
8
Date d'inscription
lundi 16 janvier 2017
Statut
Membre
Dernière intervention
19 janvier 2017

En fait il copie toujours depuis A1 je pense
Messages postés
8
Date d'inscription
lundi 16 janvier 2017
Statut
Membre
Dernière intervention
19 janvier 2017

Aurais-tu une réponse à ma dernière problématique??
Merci Merci Merci
Messages postés
8
Date d'inscription
lundi 16 janvier 2017
Statut
Membre
Dernière intervention
19 janvier 2017

Bonjour,

J'ai réussi à trouver ma réponse.
Si la colonne A n'était pas rempli ça ne marchait pas.

Merci en tous cas pour le travail fourni

Adrien