Bonjour à tous,
J'ai écrit une petite macro Excel qui me permet de récupérer les titres d'un grand nombre d'articles issus de Wikipédia.
En réalité, la macro est une boucle qui me permet de récupérer environ 300 titres à chaque fois.
J'aurais aimé faire tourner cette boucle 100 fois (voire plus) afin de récupérer au moins 30000 titres.
Cependant, après 40 ou 50 passage dans la boucle, la macro semble faire planter Excel. J'ai mis une barre de progression pour me rendre compte du bon déroulement de la macro et vers 40% Excel semble tourner dans le vide.
Vraiment est-ce que mon ordinateur n'est pas assez puissant pour récupérer 30000 mots de moins de 255 caractères ou c'est moi qui passe à côté de qqch ?
Merci d'avance pour votre aide !
Et le code de ma macro:
Sub Wiki()
Dim count As Integer
Dim nb As Integer
count = 0
nb = 100
For i = 1 To nb
Application.ScreenUpdating = False
Application.StatusBar = "Déroulement " & ((i / nb) * 100) & "%"
If i > 1 Then
a = 1
Else
a = 0
End If
count = count + 345 - a
Worksheets("Feuil1").Activate
Range("A" & count).Select
Selection.Copy
Worksheets("Feuil2").Activate
Range("H2").Select
ActiveSheet.Paste
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;https://fr.wikipedia.org/w/index.php?title=Sp%C3%A9cial%3AToutes+les+pages&from=" & Range("H2") & "&to=&namespace=0&hideredirects=1", _
Destination:=Range("$A$1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Rows("1:14").Select
Selection.Delete Shift:=xlUp
Rows("345:400").Select
Selection.Delete Shift:=xlUp
Range("A1:A344").Select
Selection.Copy
Worksheets("Feuil1").Activate
Range("A" & count + 1).Select
ActiveSheet.Paste
Worksheets("Feuil2").Activate
Cells.Select
Selection.Delete Shift:=xlUp
Next
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub