XL 2019 Regrouper les données de plusieurs feuilles dans une seule Feuille

KTM

XLDnaute Impliqué
Bonsoir chers tous
Je voudrais regrouper les données des certaines feuilles de mon classeur "ONC" dans la feuille "BASE" d'un autre classeur "RESUME".
Jai élaboré une macro dans le classeur "RESUME" qui fonctionne bien avec 13 feuilles a consolider mais avec plus de 13 feuilles mon ordinateur tend à se planter.
Pouvez vous m'aider à optimiser ma macro pour la rendre plus rapide ?
Merci.
 

Pièces jointes

  • ONC.xlsm
    319.2 KB · Affichages: 11
  • RESUME.xlsm
    20.1 KB · Affichages: 10

Oneida

XLDnaute Impliqué
Bonjour,

VBA a les limites de son programmeur. Evidement le code doit etre bien structure
Par contre le PC utilise donne les limites des temps d'executions.
Chez moi avec un core I7 qui n'est pas d'aujourd'hui, temps d'excec de son code: 5,5s a 6s avec 45 feuilles
Power Qwery ok sous reserve de savoir l'utiliser et probleme de framwork ou autre
 

wDog66

XLDnaute Occasionnel
Bonjour Oneida,

Quand je parle de limite, je parle surtout du temps de traitement pour de grosses masses de données 🤪

Ensuite, aujourd'hui les grand groupes dont je fais parti, sont dans le Cloud...
aller faire du VBA dedans 😂🤣

Bonne journée
 

KTM

XLDnaute Impliqué
Re,
Franchement tu le fais exprès ou tu es "bêtes" :rolleyes: 🤔

Je répondais à ceci

VBA n'a pas que les limites de son programmeur aujourd'hui...
Travaille un peu dans le présent, voir le futur... arrête le passé 🤪

Nous faisons de magnifiques applications avec les Power Microsoft tu sais 😁
Je vois que je n'aurai pas cette fois une solution à ma préoccupation !!!!
 

vgendron

XLDnaute Barbatruc
Hello

une proposition en PJ
l'idée est de passer par des tables

VB:
Sub consolider2()
Dim i As Long
Dim fichie As Variant
Dim wkb1 As Worksheet
Dim lr As Long
Dim shF As Worksheet
Dim classeur
Dim Région As String
Dim District As String
Dim Etab As String

Dim TabSource0(), TabSource1(), TabSource2(), TabSource3() As Variant

Dim deb As Long

Application.ScreenUpdating = False

    Set shF = ThisWorkbook.Worksheets("BASE")
    ChDir ActiveWorkbook.Path
    fichie = Application.GetOpenFilename(Title:="Selectionnez le Fichier de données à importer", filefilter:="Fichier Excel (*.xls*),*xlsm*", buttontext:="Cliquez")
  
    If fichie <> False Then
      
        Set classeur = Application.Workbooks.Open(fichie)
        deb = Timer
        With classeur
            For i = 7 To (6 + 13)
                With .Worksheets(i)
                    TabSource0 = .Range("C12:C27").Value
                    TabSource1 = .Range("D12:AL27").Value
                    TabSource2 = .Range("D33:AL48").Value
                    TabSource3 = .Range("D54:AL69").Value
                    Région = .Range("J5")
                    District = .Range("O5")
                    Etab = .Range("V5")
                End With
              
                lr = shF.Range("A" & Rows.Count).End(xlUp).Row + 1
                shF.Range("A" & lr).Resize(16) = Région
                shF.Range("B" & lr).Resize(16) = District
                shF.Range("C" & lr).Resize(16) = Etab

                shF.Range("D" & lr).Resize(UBound(TabSource0, 1)) = TabSource0
                shF.Range("E" & lr).Resize(16, 35) = TabSource1
                shF.Range("AN" & lr).Resize(16, 35) = TabSource2
                shF.Range("BW" & lr).Resize(16, 35) = TabSource3
              
                Set wkb1 = Nothing
            Next i
        End With
        classeur.Close SaveChanges:=False
    Else
        MsgBox "Pas d'ONC selectionné !!!"
        Exit Sub
    End If
  
Application.ScreenUpdating = True
MsgBox Timer - deb
End Sub

par rapport à ta macro initiale, le temps d'execution est divisé par 10
 

KTM

XLDnaute Impliqué
Hello

une proposition en PJ
l'idée est de passer par des tables

VB:
Sub consolider2()
Dim i As Long
Dim fichie As Variant
Dim wkb1 As Worksheet
Dim lr As Long
Dim shF As Worksheet
Dim classeur
Dim Région As String
Dim District As String
Dim Etab As String

Dim TabSource0(), TabSource1(), TabSource2(), TabSource3() As Variant

Dim deb As Long

Application.ScreenUpdating = False

    Set shF = ThisWorkbook.Worksheets("BASE")
    ChDir ActiveWorkbook.Path
    fichie = Application.GetOpenFilename(Title:="Selectionnez le Fichier de données à importer", filefilter:="Fichier Excel (*.xls*),*xlsm*", buttontext:="Cliquez")
 
    If fichie <> False Then
     
        Set classeur = Application.Workbooks.Open(fichie)
        deb = Timer
        With classeur
            For i = 7 To (6 + 13)
                With .Worksheets(i)
                    TabSource0 = .Range("C12:C27").Value
                    TabSource1 = .Range("D12:AL27").Value
                    TabSource2 = .Range("D33:AL48").Value
                    TabSource3 = .Range("D54:AL69").Value
                    Région = .Range("J5")
                    District = .Range("O5")
                    Etab = .Range("V5")
                End With
             
                lr = shF.Range("A" & Rows.Count).End(xlUp).Row + 1
                shF.Range("A" & lr).Resize(16) = Région
                shF.Range("B" & lr).Resize(16) = District
                shF.Range("C" & lr).Resize(16) = Etab

                shF.Range("D" & lr).Resize(UBound(TabSource0, 1)) = TabSource0
                shF.Range("E" & lr).Resize(16, 35) = TabSource1
                shF.Range("AN" & lr).Resize(16, 35) = TabSource2
                shF.Range("BW" & lr).Resize(16, 35) = TabSource3
             
                Set wkb1 = Nothing
            Next i
        End With
        classeur.Close SaveChanges:=False
    Else
        MsgBox "Pas d'ONC selectionné !!!"
        Exit Sub
    End If
 
Application.ScreenUpdating = True
MsgBox Timer - deb
End Sub

par rapport à ta macro initiale, le temps d'execution est divisé par 10
SUPER ,C'est Phénoménal !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

Oneida

XLDnaute Impliqué
Re,
Franchement tu le fais exprès ou tu es "bêtes" :rolleyes: 🤔

Je répondais à ceci

VBA n'a pas que les limites de son programmeur aujourd'hui...
Travaille un peu dans le présent, voir le futur... arrête le passé 🤪

Nous faisons de magnifiques applications avec les Power Microsoft tu sais 😁
Bonjour,
Si vous le dites.
Il semblerait qu'une infinite de personne ait quand meme besoin du VBA
Regardez post #8
Code de vgendron ca le fait!
Je l'ai modifie pour 45 feuilles: 1,3s contre 3s chez moi du code d'origine(au debut je avais mis le temps avant le choix du fichier.Oups!)
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
313 311
Messages
2 097 039
Membres
106 816
dernier inscrit
Garry972