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 x

Le 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...

Rechercher des sujets similaires à "rapidifier boucle extraction donnees entre workbooks"