Aide sur code VBA Résolu/Fermé

Question

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

Deluxe35 · Answer

Petit Précision je suis sur Office 2016

ThauTheme · Answer

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

Deluxe35 · Answer

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!

ThauTheme · Answer

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

Deluxe35 · Answer

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

Deluxe35 · Answer

Aurais-tu une réponse à ma dernière problématique??
Merci Merci Merci

Deluxe35 · Answer

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

Aide sur code VBA

7 réponses

Discussions similaires