Extraction de données dans divers fichiers xls d'un même dossier Fermé

Question

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

cs_Le Pivert · Answer

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

Ju33 · Answer

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

Extraction de données dans divers fichiers xls d'un même dossier

2 réponses

Discussions similaires