Récupération multi-page en VBA pour le WEB

Bonjour,

Je cherche à récupérer des données sur internet, le problème c'est que j'ai réaliser un code basic en VBA pour récupérer les fiches et les triées une à une mais j'en est 9000 à faire et je n'arrive pas à automatiser mon code.

Je cherche à faire en sorte que le i (qui change le numéro dans mon lien internet commence à 0 puis 1 , 2 ... 9000 à chaque fois qu'il a terminé de faire la récupération)

Le problème c'est qu'il y a des pages qui ne fonctionne pas !!

Je travail sur Office 2007 sur Windows PC.

Je remercie d'avance ceux qui prendront le temps de regarder.

Voici le code

Sub importer()

i = 1023
With Sheets("TEMP").QueryTables.Add(Connection:= _
"URL;http://www.mineralinfo.fr/Fiches/carmat/" & i, Destination:=Sheets("TEMP").Range( _
"$A$1"))
.Name = "4"
.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

compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 3) = "Nom" Then
Sheets("ACCUEIL").Cells(i, compteur) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 1 Then Exit For

End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 9) = "Exploitée" Then
Sheets("ACCUEIL").Cells(i, compteur + 1) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 2 Then Exit For
End If

Next

compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 5) = "Fiche" Then
Sheets("ACCUEIL").Cells(i, compteur + 2) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 3 Then Exit For
End If

Next

compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 11) = "Département" Then
Sheets("ACCUEIL").Cells(i, compteur + 3) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 4 Then Exit For
End If

Next

compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 6) = "Commune" Then
Sheets("ACCUEIL").Cells(i, compteur + 4) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 5 Then Exit For
End If

Next

compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 6) = "Code P" Then
Sheets("ACCUEIL").Cells(i, compteur + 5) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 6 Then Exit For
End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 6) = "Numéro" Then
Sheets("ACCUEIL").Cells(i, compteur + 6) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 7 Then Exit For
End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 6) = "Code B" Then
Sheets("ACCUEIL").Cells(i, compteur + 7) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 8 Then Exit For
End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 4), 3) = "Fin" Then
Sheets("ACCUEIL").Cells(i, compteur + 8) = Sheets("TEMP").Cells(ligne + 1, 4)
If compteur = 9 Then Exit For
End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 6) = "Statut" Then
Sheets("ACCUEIL").Cells(i, compteur + 9) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 10 Then Exit For

End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 4) = "Type" Then
Sheets("ACCUEIL").Cells(i, compteur + 10) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 10 Then Exit For

End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 13) = "Réaménagement" Then
Sheets("ACCUEIL").Cells(i, compteur + 11) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 12 Then Exit For

End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 7) = "Hauteur" Then
Sheets("ACCUEIL").Cells(i, compteur + 12) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 13 Then Exit For

End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 9) = "Epaisseur" Then
Sheets("ACCUEIL").Cells(i, compteur + 13) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 14 Then Exit For

End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 10) = "Profondeur" Then
Sheets("ACCUEIL").Cells(i, compteur + 14) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 15 Then Exit For

End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 7) = "Surface" Then
Sheets("ACCUEIL").Cells(i, compteur + 15) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 16 Then Exit For

End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 8) = "Géologie" Then
Sheets("ACCUEIL").Cells(i, compteur + 16) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 17 Then Exit For

End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 9) = "Typologie" Then
Sheets("ACCUEIL").Cells(i, compteur + 17) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 18 Then Exit For

End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 3) = "Age" Then
Sheets("ACCUEIL").Cells(i, compteur + 18) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 19 Then Exit For

End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 11) = "Morphologie" Then
Sheets("ACCUEIL").Cells(i, compteur + 19) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 20 Then Exit For

End If

Next
compteur = 1
For ligne = 1 To 100
If Left(Sheets("TEMP").Cells(ligne, 1), 10) = "Lithologie" Then
Sheets("ACCUEIL").Cells(i, compteur + 20) = Sheets("TEMP").Cells(ligne, 1)
If compteur = 21 Then Exit For

End If

Sheets(Array("Temp")).Select
Cells.Select
Selection.ClearContents

Next

End Sub