Aide sur code VBA
Résolu
Deluxe35
Messages postés
8
Date d'inscription
Statut
Membre
Dernière intervention
-
Deluxe35 Messages postés 8 Date d'inscription Statut Membre Dernière intervention -
Deluxe35 Messages postés 8 Date d'inscription Statut Membre Dernière intervention -
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
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
A voir également:
- Aide sur code VBA
- Code ascii - Guide
- Code puk bloqué - Guide
- Code activation windows 10 - Guide
- Comment déverrouiller un téléphone quand on a oublié le code - Guide
- Code blocks - Télécharger - Langages
7 réponses
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 :
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
Re,
Plutôt que nommer la plage dans chaque fichier, si ton tableau commence en A1, remplace :
par :
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
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!
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!
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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
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
