Code VBA non fonctionnel
Fermé
bonobovert
Messages postés
5
Date d'inscription
dimanche 16 septembre 2018
Statut
Membre
Dernière intervention
17 septembre 2018
-
16 sept. 2018 à 05:55
f894009 Messages postés 17198 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 26 juillet 2024 - 17 sept. 2018 à 12:57
f894009 Messages postés 17198 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 26 juillet 2024 - 17 sept. 2018 à 12:57
A voir également:
- Code VBA non fonctionnel
- Code asci - Guide
- Code puk bloqué - Guide
- Code telephone oublié - Guide
- Code activation windows 10 - Guide
- Code gta 4 ps4 - Guide
3 réponses
M-12
Messages postés
1331
Date d'inscription
lundi 22 septembre 2008
Statut
Membre
Dernière intervention
8 avril 2023
284
16 sept. 2018 à 06:30
16 sept. 2018 à 06:30
Bonjour,
Teste comme ceci, la variable Dl définie la dernière ligne de chaque classeur ouvert
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
f894009
Messages postés
17198
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 juillet 2024
1 708
Modifié le 16 sept. 2018 à 17:26
Modifié le 16 sept. 2018 à 17:26
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
vu le nombre de fichiers (200), il faudrait plutot s'orienter vers une recuperation de donnees classeurs fermes
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
bonobovert
Messages postés
5
Date d'inscription
dimanche 16 septembre 2018
Statut
Membre
Dernière intervention
17 septembre 2018
17 sept. 2018 à 07:47
17 sept. 2018 à 07:47
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.
f894009
Messages postés
17198
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
26 juillet 2024
1 708
17 sept. 2018 à 12:57
17 sept. 2018 à 12:57
Bonjour,
Le nom de feuille....
Le nom de feuille....
bonobovert
Messages postés
5
Date d'inscription
dimanche 16 septembre 2018
Statut
Membre
Dernière intervention
17 septembre 2018
16 sept. 2018 à 16:29
16 sept. 2018 à 16:29
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...
17 sept. 2018 à 05:20
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...
17 sept. 2018 à 05:50
Sans exemple devant mon nez, je ne peut deviner
17 sept. 2018 à 07:42