Sujet Précédent Sujet Suivant

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 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 - 28 nov. 2019 à 18:07
Bonjour,

Je suis en train de faire une macro sous Excel 2016. Je suis novice et rencontre quelques difficultés pour "finaliser" le projet….

Voici le code à l'instant T :

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

'******************************* 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

Voici les problèmes rencontrés :
-Au lieu de mettre les informations dans la ligne en dessous de la première pour le fichier A, cela me met les informations dans la ligne au dessus…. Cela modifie donc le nom de mes colonnes… au lieu d'ajouter les informations à la suite.

-Il faudrait que cela me copie la valeur de la cellule source et non la formule qui y est insérée.

-La mise en forme du fichier source est conservée lors du copiage, cependant j'aimerais que ce soit la mise en forme du fichier de synthèse qui soit appliquée.

-Et pour finir, mon code sera parfait lorsque j'aurais inséré une boucle qui dit "ouvrir un à un les fichier du répertoire XXX, pour effectuer le copié collé" .. Pour l'instant la macro ne traite que 2 fichiers…

MERCI par avance pour votre aide précieuse!
Ju

Configuration: Windows / Edge 18.17763
A voir également:

2 réponses

Réponse 1 / 2
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
27 nov. 2019 à 13:58
Bonjour, 

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
1
Ju33
27 nov. 2019 à 14:04
Merci pour le retour,
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 ?
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
27 nov. 2019 à 14:52
regarde cela pour parcourir un répertoire:

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à
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
27 nov. 2019 à 16:14
Tu peux t'inspirer de ce post:

https://forums.commentcamarche.net/forum/affich-36313734-copier-la-meme-cellule-de-plusieurs-classeur-dans-un-autre#1

@+ Le Pivert
0
Réponse 2 / 2
Ju33
28 nov. 2019 à 15:36
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
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
28 nov. 2019 à 18:07
L'as-tu mis juste avant d'ouvrir chaque fichier comme cela? 

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?

@+
0

Discussions similaires

Extraire le contenu de plusieurs fichiers
politicus -
Syl_tls1 -

11 réponses
comment donner les droits sur fichier partage
ch'ti du 57 -
fil1958 -

2 réponses
Créer playlist
Mots croisés -
thegoaty -

10 réponses
ou sont les bananes ?
Liline -
Le Pro -

2 réponses