Macro qui s’exécute pas si plus de 40000 lignes

Bonjour,

Sur cette macro, elle ne fonctionne pas si j'ai 40 000 lignes par contre elle fonctionne avec 30000 lignes

Comment modifier cette macro pour qu'elle prennne en compte mes 40000 lignes?

Sub TesterLaVitesseDeMacro()

On Error GoTo Erreur

'stocker le moment de début
MacroDebut = Now

Dim i%, k%, URL$, avant1$, avant2$, apres1$, apres2$, indice%

On Error Resume Next
    For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row

        DoEvents
        URL = Cells(i, "B").Value

        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", URL, False
            .Send
            If .Status = 200 Then
                For k = 1 To 17
                    avant1 = Sheets("paramètres").Range("avant1").Offset(0, k).Value
                    apres1 = Sheets("paramètres").Range("apres1").Offset(0, k).Value
                    avant2 = Sheets("paramètres").Range("avant2").Offset(0, k).Value
                    apres2 = Sheets("paramètres").Range("apres2").Offset(0, k).Value
                    Cells(i, "B").Offset(0, k).Value = Replace(mydata(.responseText, avant1, apres1, avant2, apres2), Chr(10), "")
                Next
                Cells(i, "B").Offset(0, k).Value = Date
            End If
        End With
    Next

    'comparer le début & la fin et afficher le résultat
MsgBox "Durée d'exécution: " & Format(Now - MacroDebut, "hh:mm:ss")
Exit Sub

Erreur:
MsgBox "Une erreur est survenue..."
End Sub

Function mydata(texte As String, debut1 As String, fin1 As String, debut2 As String, fin2 As String)
    mydata = Split(Split(texte, debut1)(1), fin1)(0)
    If debut2 <> "" And fin2 <> "" Then mydata = Split(Split(mydata, debut2)(1), fin2)(0)
End Function

Bonjour,

Remplacer Dim i% par Dim i& (As long)

Dim i&, k%, URL$, avant1$, avant2$, apres1$, apres2$

A+