A voir également:
- Aide sur code VBA
- Code vba pour arrêter une macro ✓ - Forum - Bureautique
- Code vba pour convertir chiffre en lettre - Conseils pratiques - Langages
- Code vba pour enregistrer une feuille excel en pdf ✓ - Forum - Excel
- Arrêter une macro ✓ - Forum - VB / VBA
- Code vba pour passer à la ligne suivante ✓ - Forum - Excel
7 réponses
ThauTheme
- Messages postés
- 1412
- Date d'inscription
- mardi 21 octobre 2014
- Statut
- Membre
- Dernière intervention
- 9 mars 2021
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
ThauTheme
- Messages postés
- 1412
- Date d'inscription
- mardi 21 octobre 2014
- Statut
- Membre
- Dernière intervention
- 9 mars 2021
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
Deluxe35
- 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
Deluxe35
- 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!
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!
Deluxe35
- 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
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
