Macro qui plante alors qu’elle fonctionne

Bonjour, je m’appelle Joris, merci a tous les membres du forum toute ma macro a ete realiser grace aux nombreux posts du forum.

Pour ma question, j’ai une macro avec jne boucle, dans cette boucle je recupere une page web (les urls sont dans une feuille du classeur et a chaque tour je prend la suivante). Toutes les urls sont tester avant d’etre entrer dans la feuille et donc valide...

Si je regle ma boucle pour recuperer deux ou vingt page, pas de souci. Si je regle sur 150 par exemple, tout ce passe bien pendant toute la duree du processus, et ca plante a la fin. C’est a dire que si je regle sur 150 tour, excel fait ca popote pendant 5h (temps exact dailleur que je trouve si je multiplie le temp d’execution d’un tour par 150) puis excel ne repond plus, je foece la fermeture et la alors je vois bievement l’erreur « connexion termine par le client » ou un truc du genre... bref vraiment bizarre.

Mefci

Bonjour Joris,

Tu n'as transmis aucun code ni fichier, je vois mal comment on pourrait t'aider avec aussi peu d'éléments...

Voila je vous joint le code de la macro

Sub Macro4()

compteur_ligne_feuille_finalle = 0
compteur_pdt = 1
compteur_col_img = 3
com = 1

' Permet de régler le nombre de produit à traiter
    While com < 100

' Nettoi l'emplacement d'écriture du produit à traiter pendant la boucle
    Sheets("Produits").Columns("C:E").Clear

' Définit le produit à traiter
    compteur_pdt = compteur_pdt + 2
    testty = Sheets("Produits").Cells(compteur_pdt, 1)

' Récupère et écrit en C1-Produits les informations du produit à traiter dans la boucle
    Sheets("Produits").Select
    Range("C1").Select
    Application.CutCopyMode = False
    With Sheets("Produits").QueryTables.Add(Connection:= _
        "URL;" & testty, Destination:=Range("$C$1"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingAll
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    ActiveWindow.SmallScroll Down:=120
    Range("D1:E5000").MergeCells = False

' Définit sur la feuille finalle dans quelle ligne le produit en cour de traitement doit être écrit
    compteur_ligne_feuille_finalle = compteur_ligne_feuille_finalle + 1

' Boucle de traitement du descriptif produit, 340 est une valeur arbitraire, aucune information du produit n'est situé aprés cette ligne
    For ligne = 1 To 340

' Définit le début de la description du produit
    If Left(Sheets("Produits").Cells(ligne, 3), 15) = "En savoir plus" Then
    lignedeb = ligne
    Else
    If Left(Sheets("Produits").Cells(ligne, 3), 14) = "En savoir plus" Then
    lignedeb = ligne
    Else
    End If
    End If

' Définit la fin de la description du produit
    If Left(Sheets("Produits").Cells(ligne, 3), 10) = "Catégories" Then
    lignefin = ligne
    End If

' Boucle de récupération de la description du produit
    While lignedeb < lignefin
    Sheets("Feuil1").Cells(compteur_ligne_feuille_finalle, 2) = Sheets("Feuil1").Cells(compteur_ligne_feuille_finalle, 2) & Sheets("Produits").Cells(lignedeb, 3) & "<br/>"
    lignedeb = lignedeb + 1
    Wend

' Permet de récupérer l'image d'un produit lorsqu'il y en a qu'une
    If Left(Sheets("Produits").Cells(ligne, 3), 12) = "Référence : " Then
    Sheets("Feuil1").Cells(compteur_ligne_feuille_finalle, 3) = AdrHyperlien(Sheets("Produits").Cells(ligne - 2, 3))
    End If

' Récupération des images
    If Left(Sheets("Produits").Cells(ligne, 3), 9) = "Précédent" Then
    lignedeb2 = ligne
    Else
    If Left(Sheets("Produits").Cells(ligne, 3), 7) = "Suivant" Then
    lignefin2 = ligne - 1
    While lignefin2 - lignedeb2 > 4
    lignefin2 = lignefin2 - 1
    Wend
    While lignedeb2 < lignefin2
    lignedeb2 = lignedeb2 + 1
    Sheets("Feuil1").Cells(compteur_ligne_feuille_finalle, compteur_col_img) = AdrHyperlien(Sheets("Produits").Cells(lignedeb2, 3))
    compteur_col_img = compteur_col_img + 1
    Wend
    End If
    End If

' Permet de récupérer le nom d'un produit
    If Left(Sheets("Produits").Cells(ligne, 3), 12) = "Référence : " Then
    Sheets("Feuil1").Cells(compteur_ligne_feuille_finalle, 11) = Sheets("Produits").Cells(ligne - 1, 3)
    End If

' Permet de récupérer le type d'un produit
    If Left(Sheets("Produits").Cells(ligne, 3), 4) = "Type" Then
    Sheets("Feuil1").Cells(compteur_ligne_feuille_finalle, 12) = Sheets("Produits").Cells(ligne, 4)
    End If

' Permet de récupérer le protocole d'un produit
    If Left(Sheets("Produits").Cells(ligne, 3), 9) = "Protocole" Then
    Sheets("Feuil1").Cells(compteur_ligne_feuille_finalle, 13) = Sheets("Produits").Cells(ligne, 4)
    End If

' Récupération du Fabricant
    If Left(Sheets("Produits").Cells(ligne, 3), 11) = "Fabricant :" Then
    compteur = compteur + 1
    Sheets("Feuil1").Cells(compteur, 1) = Sheets("Produits").Cells(ligne, 3)
    End If

' Permet de récupérer la référence d'un produit
    If Left(Sheets("Produits").Cells(ligne, 3), 12) = "Référence : " Then
    Sheets("Feuil1").Cells(compteur_ligne_feuille_finalle, 6) = Sheets("Produits").Cells(ligne, 3)
    End If

' Permet de récupérer la catégorie d'un produit
    If Left(Sheets("Produits").Cells(ligne, 3), 10) = "Promotions" And ligne < 100 Then
    ligne_categorie = ligne + 1
    Set test = Sheets("Produits").Cells(ligne_categorie, 3)
    test3 = Mid(test, 2, WorksheetFunction.Search(">", test, 13) - 2)
    Sheets("Feuil1").Cells(compteur_ligne_feuille_finalle, 7) = test3
    Set test4 = Sheets("Feuil1").Cells(compteur_ligne_feuille_finalle, 7)
    test2 = Mid(test4, WorksheetFunction.Search(">", test, 2))
    Sheets("Feuil1").Cells(compteur_ligne_feuille_finalle, 8) = test2
    End If

' Permet de récupérer le prix d'un produit
    If Right(Sheets("Produits").Cells(ligne, 3), 2) = "HT" Then
    Sheets("Feuil1").Cells(compteur_ligne_feuille_finalle, 9) = Sheets("Produits").Cells(ligne, 3)
    End If

' Permet de récupérer le stock d'un produit
    If Left(Sheets("Produits").Cells(ligne, 3), 5) = "Stock" Then
    Sheets("Feuil1").Cells(compteur_ligne_feuille_finalle, 10) = Sheets("Produits").Cells(ligne, 3)
    End If

    If compteur = 340 Then Exit For

    Next

    com = com + 1

    Wend

End Sub