Extraction de données dans divers fichiers xls d'un même dossier
Fermé
Ju33
-
27 nov. 2019 à 13:32
cs_Le Pivert Messages postés 7883 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 18 mars 2023 - 28 nov. 2019 à 18:07
cs_Le Pivert Messages postés 7883 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 18 mars 2023 - 28 nov. 2019 à 18:07
A voir également:
- Extraction de données dans divers fichiers xls d'un même dossier
- Téléchargez cette archive (dossier compressé). en extraire tous les fichiers dans un dossier local. quel fichier contient l’expression trouverpix ? ✓ - Forum Windows
- Wetransfer gratuit fichiers lourd - Guide
- Mettre un mot de passe sur un dossier - Guide
- WeTransfer - Télécharger - Téléchargement & Transfert
- Dossier appdata - Guide
2 réponses
cs_Le Pivert
Messages postés
7883
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
18 mars 2023
724
27 nov. 2019 à 13:58
27 nov. 2019 à 13:58
Bonjour,
te donne la dernière ligne renseignée. Il faut donc ajouter une ligne pour avoir la 1ère ligne vide.
Comme ceci:
j = wkA.Sheets("Suividevis").Range("A" & Rows.Count).End(xlUp).Row
te donne la dernière ligne renseignée. Il faut donc ajouter une ligne pour avoir la 1ère ligne vide.
Comme ceci:
j = wkA.Sheets("Suividevis").Range("A" & Rows.Count).End(xlUp).Row + 1
Bonjour,
J'ai abouti quant à mon besoin, j'ai seulement un problème qui persiste...
J'avais essayé "Application.DisplayAlerts = False/True" pour empêcher les pop-ups de s'ouvrir mais cela ne fonctionne pas…
En fait c'est une fenêtre d'alerte indiquant que le fichier est à la dernière version existante, qui s'ouvre à l'ouverture de chaque fichier source… Or il y a 50 fichiers source, cela demande de rester derrière le PC et cliquer sur "OK" toutes les 5 secondes. Très gênant.
Avez-vous une solution ?
Merci
Ju
J'ai abouti quant à mon besoin, j'ai seulement un problème qui persiste...
J'avais essayé "Application.DisplayAlerts = False/True" pour empêcher les pop-ups de s'ouvrir mais cela ne fonctionne pas…
En fait c'est une fenêtre d'alerte indiquant que le fichier est à la dernière version existante, qui s'ouvre à l'ouverture de chaque fichier source… Or il y a 50 fichiers source, cela demande de rester derrière le PC et cliquer sur "OK" toutes les 5 secondes. Très gênant.
Avez-vous une solution ?
Merci
Ju
cs_Le Pivert
Messages postés
7883
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
18 mars 2023
724
28 nov. 2019 à 18:07
28 nov. 2019 à 18:07
L'as-tu mis juste avant d'ouvrir chaque fichier comme cela?
Si le message persiste il faudrait voir dans les options d'Excel.
Ce n'est pas une version limitée?
@+
For Each fichier In dossier.Files
If fichier = ThisWorkbook.Path & "\" & ThisWorkbook.Name Then 'chemin classeur reception
Else
Application.DisplayAlerts = False
Set wb = Workbooks.Open(fichier)
Si le message persiste il faudrait voir dans les options d'Excel.
Ce n'est pas une version limitée?
@+
27 nov. 2019 à 14:04
Après modification, la macro a une erreur, elle m'indique 2 fois les résultats du second fichier l'un en dessous de l'autre et n'affiche plus le résultat du fichier A :
Sub ESSAI1()
Dim wkA As Workbook, wkB As Workbook
Dim chemin As String, fichier As String
Dim j As Long
Application.ScreenUpdating = False 'gagner en temps d'execution
Set wkA = ThisWorkbook 'le dossier qui va recevoir les donn?es
chemin = "C:\Users\T0159962\Desktop\Direction Technique\Devis Ingenierie\" 'adresse commun pour les deux dossiers sources
'******************************* Copier donnees Classeur A
fichier = "TDMSFR1268093-00 - FPV - SPGE - FT287 rev 00" 'Nom du classeur 1
Workbooks.Open chemin & fichier & ".xlsm" 'ouvrir classeur1
Set wkB = ActiveWorkbook
j = 2
wkB.Worksheets("Contexte").Range("L17").Copy wkA.Sheets("Suividevis").Cells(j, 3)
wkB.Worksheets("Contexte").Range("E12").Copy wkA.Sheets("Suividevis").Cells(j, 4)
wkB.Worksheets("Contexte").Range("F2").Copy wkA.Sheets("Suividevis").Cells(j, 5)
wkB.Worksheets("Contexte").Range("I7").Copy wkA.Sheets("Suividevis").Cells(j, 6)
wkB.Worksheets("Contexte").Range("I5").Copy wkA.Sheets("Suividevis").Cells(j, 7)
wkB.Worksheets("Contexte").Range("H12").Copy wkA.Sheets("Suividevis").Cells(j, 8)
wkB.Worksheets("Contexte").Range("O2").Copy wkA.Sheets("Suividevis").Cells(j, 9)
wkB.Worksheets("Contexte").Range("C18").Copy wkA.Sheets("Suividevis").Cells(j, 11)
wkB.Worksheets("Contexte").Range("D19").Copy wkA.Sheets("Suividevis").Cells(j, 12)
wkB.Worksheets("Contexte").Range("K13").Copy wkA.Sheets("Suividevis").Cells(j, 13)
wkB.Close True
j = wkA.Sheets("Suividevis").Range("A" & Rows.Count).End(xlUp).Row + 1
'******************************* Copier donnees Classeur B
fichier = "TDMSFR1266422-03- ATL2 - FPV ISTS Iguane"
Workbooks.Open chemin & fichier & ".xlsm"
Set wkB = ActiveWorkbook
wkB.Worksheets("Contexte").Range("L17").Copy wkA.Sheets("Suividevis").Cells(j, 3)
wkB.Worksheets("Contexte").Range("E12").Copy wkA.Sheets("Suividevis").Cells(j, 4)
wkB.Worksheets("Contexte").Range("F2").Copy wkA.Sheets("Suividevis").Cells(j, 5)
wkB.Worksheets("Contexte").Range("I7").Copy wkA.Sheets("Suividevis").Cells(j, 6)
wkB.Worksheets("Contexte").Range("I5").Copy wkA.Sheets("Suividevis").Cells(j, 7)
wkB.Worksheets("Contexte").Range("H12").Copy wkA.Sheets("Suividevis").Cells(j, 8)
wkB.Worksheets("Contexte").Range("O2").Copy wkA.Sheets("Suividevis").Cells(j, 9)
wkB.Worksheets("Contexte").Range("C18").Copy wkA.Sheets("Suividevis").Cells(j, 11)
wkB.Worksheets("Contexte").Range("D19").Copy wkA.Sheets("Suividevis").Cells(j, 12)
wkB.Worksheets("Contexte").Range("K13").Copy wkA.Sheets("Suividevis").Cells(j, 13)
wkB.Close True
Application.ScreenUpdating = True
End Sub
Voyez vous le problème ?
27 nov. 2019 à 14:52
https://vbaforexcel.wordpress.com/2013/09/06/lister-les-fichiers-et-sous-dossiers-dun-dossier/
elle m'indique 2 fois les résultats du second fichier l'un en dessous de l'autre :
c'est normal, tu as mis 2 fois la même chose:
wkB.Worksheets("Contexte").Range("L17").Copy wkA.Sheets("Suividevis").Cells(j, 3) wkB.Worksheets("Contexte").Range("E12").Copy wkA.Sheets("Suividevis").Cells(j, 4) wkB.Worksheets("Contexte").Range("F2").Copy wkA.Sheets("Suividevis").Cells(j, 5) wkB.Worksheets("Contexte").Range("I7").Copy wkA.Sheets("Suividevis").Cells(j, 6) wkB.Worksheets("Contexte").Range("I5").Copy wkA.Sheets("Suividevis").Cells(j, 7) wkB.Worksheets("Contexte").Range("H12").Copy wkA.Sheets("Suividevis").Cells(j, 8) wkB.Worksheets("Contexte").Range("O2").Copy wkA.Sheets("Suividevis").Cells(j, 9) wkB.Worksheets("Contexte").Range("C18").Copy wkA.Sheets("Suividevis").Cells(j, 11) wkB.Worksheets("Contexte").Range("D19").Copy wkA.Sheets("Suividevis").Cells(j, 12) wkB.Worksheets("Contexte").Range("K13").Copy wkA.Sheets("Suividevis").Cells(j, 13)Voilà
27 nov. 2019 à 16:14
https://forums.commentcamarche.net/forum/affich-36313734-copier-la-meme-cellule-de-plusieurs-classeur-dans-un-autre#1
@+ Le Pivert