Bonjour à tous,
 
Je réalise un programme en VBA dans lequel je fais une mise à jours de trois requêtes avec paramêtres:  
            Range("A2" ).Select
            Selection.QueryTable.Refresh BackgroundQuery:=False
            Range("H2" ).Select
            Selection.QueryTable.Refresh BackgroundQuery:=False
            Range("O2" ).Select
            Selection.QueryTable.Refresh BackgroundQuery:=False
 
Les paramètres sont renseignés dans des cellules que la requête va chercher sans problème.
 
Mon véritable problème est le suivant.
Lorsque j'utilise mon programme avec mise à jours de ces 3 requêtes en one shot pas de problème. Cependant, dès que je réalise une boucle (For... Next) sur l'un des paramètres au bout d'une trentaine de fois, ça bug. Les requêtes ne m'extraient plus toutes les données.
Message que j'obtiens:
"Cette requête a fourni plus de données que la feuille ne peut en contenir.
- Pour continuer et afficher autant de données que possible, cliquez sur ok.
- Pour annuler la requête, cliquez sur Annuler. Vous pouvez retourner dans Microsoft Query pour créer une requête qui renvoie moins de données etc. ..."
 
Juste pour vous avertir que grosso modo le nombre maxi de données que je dois extraire est de 2000 à 5000 lignes max.
 
Auriez vous des solutions ou des éléments de réponses à me communiquer pour poursuivre mon programme?  
Merci d'avance.
Cordialement.
 
Lili

C'est difficile à dire sans voir la boucle.
Peut-être qu'il faudrait ajouter un DoEvents à l'intérieur, pour que Access ait le temps de respirer.

Ma boucle est une boucle simple qui me permet juste de modifier mon paramètre (98 Noms). J'utilise une boucle for... Next.
Je n'utilise pas Access mais je crée ma requête dans excel avec Microsoft Query.

Merci en tout cas de ton aide

For l = 1 To WVL_NbrePTF
        If TABL_ListePTF(l, 1) = "x" Then
             
            Workbooks(NAME_FILE).Sheets("MENU" ).Select
            Range("C18" ).Value = TABL_ListePTF(l, 2)
            Range("G17:G18,G20:G22,G24:G26,J29,J31,K29,K31" ).Select
            Selection.ClearContents
            Range("E12" ).Select
            Workbooks(NAME_FILE).Sheets("Data" ).Select
             
            Range("A3:S3" ).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.ClearContents
 
            Range("A2" ).Select
            Selection.QueryTable.Refresh BackgroundQuery:=False
            Range("H2" ).Select
            Selection.QueryTable.Refresh BackgroundQuery:=False
            Range("O2" ).Select
            Selection.QueryTable.Refresh BackgroundQuery:=False
     
            If Range("S3" ).Value = 0 Or Range("S3" ).Value = 1 Then
                    WVL_TypeSous = "SOUSCR"
                    WVL_TypeRach = "RACHAT"
            Else
                    WVL_TypeSous = "APPORT"
                    WVL_TypeRach = "RETRAIT"
            End If
        '========================================
        '   ACHATS, VENTES
        '========================================
            WVL_NbreLignes = Application.CountA(Range("A:A" )) - 2
            WVL_TotalAchat = 0
            WVL_TotalVente = 0
            For i = 1 To WVL_NbreLignes
                If Cells(i + 2, 3).Value = "ACHAT" Then
                    WVL_TotalAchat = WVL_TotalAchat + Cells(i + 2, 4).Value
                ElseIf Cells(i + 2, 3).Value = "VENTE" Then
                    WVL_TotalVente = WVL_TotalVente + Cells(i + 2, 4).Value
                End If
            Next
        '========================================
        '   SOUSCRIPTIONS, RACHATS
        '========================================
    WVL_NbreLignes = Application.CountA(Range("H:H" )) - 2
    If WVL_NbreLignes <= 0 Then
        WVL_NbreLignes = 1
    End If
     
    ReDim TABL_DataSousRach(1 To WVL_NbreLignes, 1 To 3)
     
    For i = 1 To WVL_NbreLignes
        For c = 1 To 3
            TABL_DataSousRach(i, c) = Cells(i + 2, c + 8).Value
        Next
    Next
     
    For j = 1 To WVL_NbreLignes
        If j = 1 Then
            WVL_Compt = 1
            ReDim WVL_Dates(1 To WVL_Compt)
            WVL_Dates(WVL_Compt) = TABL_DataSousRach(j, 1)
        ElseIf j <> 1 And TABL_DataSousRach(j, 1) <> TABL_DataSousRach(j - 1, 1) Then
            WVL_Compt = WVL_Compt + 1
            ReDim Preserve WVL_Dates(1 To WVL_Compt)
            WVL_Dates(WVL_Compt) = TABL_DataSousRach(j, 1)
        End If
    Next
     
    ReDim TABL_Souscriptions(1 To WVL_Compt, 1 To 2)
    ReDim TABL_Rachats(1 To WVL_Compt, 1 To 2)
    WVL_Next = 1
    WVL_Boucle = 1
    Do While WVL_Next <= WVL_Compt
        For i = WVL_Boucle To WVL_NbreLignes
            If TABL_DataSousRach(i, 1) = WVL_Dates(WVL_Next) Then
                If TABL_DataSousRach(i, 2) = WVL_TypeSous Then
                    TABL_Souscriptions(WVL_Next, 2) = TABL_Souscriptions(WVL_Next, 2) + TABL_DataSousRach(i, 3)
                    TABL_Souscriptions(WVL_Next, 1) = WVL_Dates(WVL_Next)
                ElseIf TABL_DataSousRach(i, 2) = WVL_TypeRach Then
                    TABL_Rachats(WVL_Next, 2) = TABL_Rachats(WVL_Next, 2) + TABL_DataSousRach(i, 3)
                    TABL_Rachats(WVL_Next, 1) = WVL_Dates(WVL_Next)
                End If
            Else
                WVL_Next = WVL_Next + 1
                WVL_Boucle = i
                GoTo SUIVANT
            End If
            If WVL_Next = WVL_Compt And i = WVL_NbreLignes Then
                GoTo FIN_BOUCLE
            End If
        Next
SUIVANT:    Loop
     
FIN_BOUCLE:    ReDim TABL_SousRachNET(1 To WVL_Compt, 1 To 2)
    WVL_TotalSousRachNET = 0
    For j = 1 To WVL_Compt
         WVL_Souscription = WVL_Souscription + TABL_Souscriptions(j, 2) '## Total Souscriptions ##
         WVL_Rachat = WVL_Rachat + TABL_Rachats(j, 2) '## Total Rachats ##
         TABL_SousRachNET(j, 1) = WVL_Dates(j)
         TABL_SousRachNET(j, 2) = TABL_Souscriptions(j, 2) + TABL_Rachats(j, 2)
         WVL_TotalSousRachNET = WVL_TotalSousRachNET + Abs(TABL_SousRachNET(j, 2))
    Next
        '----------------------------------------------------------------------------
            WVL_NbreLignes = Application.CountA(Range("O:O" )) - 2
     
            WVL_ValoPTF1 = 0
            WVL_Compt = 0
            For i = 1 To WVL_NbreLignes
                If Cells(i + 2, 17).Value <> "" Then
                    WVL_ValoPTF1 = WVL_ValoPTF1 + Cells(i + 2, 17).Value
                Else
                    WVL_Compt = WVL_Compt + 1
                End If
            Next
     
            WVL_NbreJours = 0
            WVL_TurnOver_Min = 0
            WVL_TurnOver_AMF = 0
            WVL_NbreJours = (WVL_Datefin - WVL_DateDebut) + 1
            WVL_ActifMoyen = WVL_ValoPTF1 / WVL_NbreJours
             
            If WVL_ActifMoyen <> 0 Then
                WVL_TurnOver_Min = (Abs(WorksheetFunction.Min(Abs(WVL_TotalAchat), Abs(WVL_TotalVente)) - WVL_TotalSousRachNET)) / WVL_ActifMoyen
                WVL_TurnOverYear_Min = WVL_TurnOver_Min * (365 / WVL_NbreJours)
                WVL_TurnOver_AMF = (Abs(WVL_TotalAchat) + Abs(WVL_TotalVente) - WVL_TotalSousRachNET) / WVL_ActifMoyen
                WVL_TurnOverYear_AMF = WVL_TurnOver_AMF * (365 / WVL_NbreJours)
            Else
                WVL_TurnOver_Min = (Abs(WorksheetFunction.Min(Abs(WVL_TotalAchat), Abs(WVL_TotalVente)) - WVL_TotalSousRachNET))
                WVL_TurnOverYear_Min = WVL_TurnOver_Min * (365 / WVL_NbreJours)
                WVL_TurnOver_AMF = (Abs(WVL_TotalAchat) + Abs(WVL_TotalVente) - WVL_TotalSousRachNET)
                WVL_TurnOverYear_AMF = WVL_TurnOver_AMF * (365 / WVL_NbreJours)
            End If
             
            '==============================================
            ' Ouvrir Classeur, enregistrer sous + écriture
            '==============================================
            Workbooks(WVL_NameFile).Activate
            If WVL_TempLignes = 12 Then
                Cells(10, 4).Value = WVL_DateDebut & " au " & WVL_Datefin
            End If
            Cells(WVL_TempLignes, 2).Value = TABL_ListePTF(l, 2)
            Cells(WVL_TempLignes, 3).Value = TABL_ListePTF(l, 3)
            Cells(WVL_TempLignes, 4).Value = WVL_TurnOverYear_AMF 'Format(WVL_TurnOverYear_AMF, "0.00%" )
            Cells(WVL_TempLignes, 5).Value = WVL_TurnOverYear_Min 'Format(WVL_TurnOverYear_Min, "0.00%" )
             
            WVL_TempLignes = WVL_TempLignes + 1
             
            '==============================================
             
            Workbooks(NAME_FILE).Sheets("MENU" ).Activate
            Range("G17" ).Value = Abs(WVL_TotalAchat)
            Range("G18" ).Value = Abs(WVL_TotalVente)
     
            Range("G20" ).Value = Abs(WVL_Souscription)
            Range("G21" ).Value = Abs(WVL_Rachat)
            Range("G22" ).Value = WVL_Souscription + WVL_Rachat
     
            Range("G24" ).Value = WVL_ValoPTF1
            Range("G26" ).Value = WVL_ActifMoyen
     
            Range("J29" ).Value = Format(WVL_TurnOver_Min, "0.00%" )
            Range("J31" ).Value = Format(WVL_TurnOverYear_Min, "0.00%" )
             
            Range("K29" ).Value = Format(WVL_TurnOver_AMF, "0.00%" )
            Range("K31" ).Value = Format(WVL_TurnOverYear_AMF, "0.00%" )
     
            Workbooks(NAME_FILE).Sheets("MENU" ).Select
            Range("C18" ).Select
        End If
    Next

Oh tous les Redim. Je ne suis pas certain que VB les gèrent correctement. Il serait plus simple et plus sur de dimensionner au début les tableaux avec la taille maximale qu'ils peuvent avoir.
Mais le problème est peut-être ailleurs.
 
Oh les goto, et en plus il y a un goto qui sort d'une boucle pour le premier, et qui sort même de deux boucles pour le second.
Pour le GoTo SUIVANT, il suffit de le remplacer par un Exit For.
Pour le GoTo FIN_BOUCLE, on peut le remplacer aussi par WVL_Next = WVL_Next + 1 et Exit For, comme ça il sortira du For, et il ne rentrera pas dans Do While car la condition de fin sera vérifiée.
Mais le problème est peut-être ailleurs.
 
En tous, cas je conseille d'ajouter un DoEvents juste avant le dernier Next. Cela ne peut pas faire de mal.

Ok merci pour ces précieux conseils. J'apprends le vba un peu au fur et à mesure...
Je vais apporter des modifs dans mon code et te tiens au courant.
Merci.

Par contre pour les REDIM, je ne pense pas pouvoir faire autrement car je ne connais pas à l'avance les dimensions des tableaux.

Je pense que c'est un problème de mémoire ou de capacité.
Peut-on purger la mémoire ? Méthode Flush  en VBA ?
Merci

Personne ne voit de solution à mon problème.
J'ai l'impression qu'à partir d'un moment à force d'actualiser mes requêtes le système devient instable.

Je rencontre toujours le même problème à partir d'un moment, ma requête m'extrait que les 2 première lignes. Du moins, je visualise uniquement dans la feuille (état de sortie) que 2 lignes

J'ai l'impression qu'à chaque tour de ma boucle pour changer le parametre, il doit stocker l'extraction des données de la requête qq part. Et au bout d'un certain nombre de tour, il n'a plus de place pour les stocker.
D'où ce msg: "Cette requête a fourni plus de données que la feuille ne peut en contenir.  
- Pour continuer et afficher autant de données que possible, cliquez sur ok.  
- Pour annuler la requête, cliquez sur Annuler. Vous pouvez retourner dans Microsoft Query pour créer une requête qui renvoie moins de données etc. ..."  
 
Quelqu'un aurait il une solution ? Je n'arrive pas à résoudre mon problème.
 
Merci d'avance et bon après midi.

Bon la solution était dans les options de la plage de données de la requête ...