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

[KTM]

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.

 

[wDog66]

Bonjour KTM,

Mieux vaut utiliser Power Query pour faire ça, VBA à ses limites

Question : pourquoi enregistrer ONC en ".xlsm" alors qu'il ne contient pas de VBA

Bonne journée

 

[Oneida]

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]

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

 

[Oneida]

Re,
Cloud:
Ce n'est pas le cas

 

[wDog66]

Re,
Franchement tu le fais exprès ou tu es "bêtes"

Je répondais à ceci

VBA a les limites de son programmeur.

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

 

[KTM]

Re,
Franchement tu le fais exprès ou tu es "bêtes"

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]

Hello

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

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]

Hello

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

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]

Re,
Franchement tu le fais exprès ou tu es "bêtes"

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!)