Rapidifier boucle d'extraction de donnees entre plusieurs workbooks
Hello,
Je commence a apprendre le VBA pour accelerer certains processus dans mon job mais j'ai un probleme maintenant.
J'essaye d'extraire des donnees de plusieurs worksheets d'un fichier excel SOURCE a differentes worksheets d'un autre fichier excel DATA qui possede plusieurs tableaux dans chaque worksheet. Je ne suis pas hyper a l'aise en VBA donc j'ai ecris le code dans la seule maniere que je savais faire...
La macro met super longtemps a process et je me demande s'il y a pas un moyen de simplifier et/ou ameliorer ce que j'ai deja fais.
Voici mon code:
Sub DataPullPNLAllSheets()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim i As Integer
Dim ws_num As Integer
Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet
ws_num = ThisWorkbook.Worksheets.Count
'Je veux que chaque worksheet du fichier DATA soit remplies par les differentes donnees
For i = 1 To ws_num
ThisWorkbook.Worksheets(i).Activate
Range("e18").Select
'J'utilise cette cellule dans le DATA (qui est en haut de la colonne que je veux remplir) comme reference pour indiquer le path, tab et cellule ou je veux chercher la data (tout cela se situe en bas a gauche de la ref)
totalrows = ActiveCell.CurrentRegion.Rows.Count - 1
For x = 1 To totalrows
mypath = ActiveCell.Offset(x, -3).Value
mysheet = ActiveCell.Offset(x, -2).Value
mycell = ActiveCell.Offset(x, -1).Value
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Workbooks.Open Filename:=mypath
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
ActiveWorkbook.Sheets(mysheet).Activate
newvalue = Range(mycell).Value
Workbooks("Check File ( P&L vs Current VA)").Activate
ActiveCell.Offset(x, 0).Value = newvalue
Next xLe truc c'est que j'ai plusieurs tableaux a remplir (environ 30) par sheet du fichier DATA donc j'ai fais manuellement le meme code pour chaque tableau plus bas dans la sheet.
Range("e43").Select
totalrows = ActiveCell.CurrentRegion.Rows.Count - 1
For x = 1 To totalrows
mypath = ActiveCell.Offset(x, -3).Value
mysheet = ActiveCell.Offset(x, -2).Value
mycell = ActiveCell.Offset(x, -1).Value
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Workbooks("01 - YTD July 19 - MHE Reference Book - incl. FREE - by Market.xlsm").Activate
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
ActiveWorkbook.Sheets(mysheet).Activate
newvalue = Range(mycell).Value
Workbooks("Check File ( P&L vs Current VA)").Activate
ActiveCell.Offset(x, 0).Value = newvalue
Next x
Range("e68").Select
totalrows = ActiveCell.CurrentRegion.Rows.Count - 1..............etc.
Je ne sais pas s'il y a une maniere d'eviter de dupliquer le code comme j'ai fais ou meme une maniere d'eviter certains calculs qui ne sont pas necessaire. Je n'ai malheureusement pas les connaissances necessaires pour ameliorer ce code tout de suite..
Si vous avez une quelconque idee de comment ameliorer cette longue macro ce serait super cool
Bonjour Stevebobs, bienvenue sur le forum,
il est possible de lire les données de fichier sans les ouvrir,
c'est beaucoup plus rapide, mais il faut plus de détail,
peut ont rapatrier tous les données des différents onglets du fichier fermé sur un seul onglet pour les traiter par la suite ?
sans voir la disposition des données à traiter c'est difficile de prévoir la suite...