Macro import donnÉes web a la suite

Bonjour à Tous,

Je sollicite votre aide car je ne trouve pas de solution à mon problème :

J’ai une macro qui importe des données web sur un onglet « temporaire » puis une recherche est faite dans cet onglet temporaire pour me copier les résultats dans un autre.

Je souhaiterais importer les données de plusieurs adresses web répertoriées dans une colonne et que les résultats soient récupérés à la suite… (je ne sais pas si je suis bien clair) :

Les adresses web à scanner sont dans la feuil2, colonne 27 (je voudrais scanner également jusqu’à la dernière cellule de la colonne 27 non vide).

J’ai tenté de faire une boucle qui ne fonctionne que pour les scans des adresse web de ma colonne 27 mais ne copie que le dernier résultat de l’adresse web importé, je les voudrais tous à la suite dans mon autre onglet.

Voici ma macro actuelle :

Sub IMPORT_TEST()

Dim URL_ETH As String

For i = 2 To 21

URL_ETH = Feuil2.Cells(i, 27).Value

Sheets("TEMP_MONITORING").Cells.Clear

With Sheets("TEMP_MONITORING").QueryTables.Add(Connection:="URL;" & URL_ETH & "" _

, Destination:=Sheets("TEMP_MONITORING").Range("$A$1"))

.Name = "BIG BROTHER ALL"

.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

Next i

compteur = 0

For ligne = 1 To 1000

If Left(Sheets("TEMP_MONITORING").Cells(ligne, 1), 6) = "Status" Then

compteur = compteur + 1

Sheets("TEST_RESEAU").Cells(compteur, 1) = Sheets("TEMP_MONITORING").Cells(ligne - 1, 1)

If compteur = 5 Then Exit For

End If

Next

End Sub

Bonjour et bienvenue,

peux-tu nous mettre un fichier excel avec les adresses des sites ?

quelles données souhaites-tu importer ?

y a t-il des tableaux de données ? ce qui permettrait l'utilisation de Power Query ?

les données sont-elles structurées en json ?

bref, un tas de questions classiques dans ce genre de sujet, c'est pourquoi ce serait bien d'avoir les adresses des sites concernés, et cela permettrait aussi de prélever directement les informations concernées sans passer par un onglet temporaire.

Bonsoir et merci pour votre réponse.

Il s'agit de simple page web HTML intranet entreprise (pas possibilité de tester depuis l'extérieur), je ne récupère que des données texte non formatés.

Exemple :

Le début de ma macro import les données dans une feuille temporaire :

1ERE PARTIE :

Sub IMPORT_TEST()

Sheets("TEMP_MONITORING").Cells.Clear

With Sheets("TEMP_MONITORING").QueryTables.Add(Connection:="URL;http://test.fr" _

, Destination:=Sheets("TEMP_MONITORING").Range("$A$1"))

.Name = "TEST"

.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

Next i

La totalité des information texte contenu dans cette page html et reporté dans mon onglet "TEMP_MONITORING".

La deuxième partie de ma macro me permet de récupérer uniquement la ligne qui se trouve en dessous du mot "statut" (je sais sans exemple, c'est pas simple...). Le résultat de la ligne trouvée est envoyé sur l'onglet "TEST_RESEAU".

DEUXIÈME PARTIE :

compteur = 0

For ligne = 1 To 1000

If Left(Sheets("TEMP_MONITORING").Cells(ligne, 1), 6) = "Status" Then

compteur = compteur + 1

Sheets("TEST_RESEAU").Cells(compteur, 1) = Sheets("TEMP_MONITORING").Cells(ligne - 1, 1)

If compteur = 5 Then Exit For

End If

Next

End Sub

Ce que je souhaiterais faire, c'est un type de boucle sur cette macro.

J'ai plusieurs pages html de constitution identiques à scanner ou je dois récupérer la même ligne. Je souhaiterais que les résultats (Partie 2 de ma macro) se mettent à la suite dans l'onglet "TEST_RESEAU".

Les adresses des pages html à scanner sont répertoriées dans mon onglet "SOURCES", colonne 27, allant de la première ligne jusqu'à la dernière remplie.

Ne pouvant fournir un fichier fonctionnel, j'espère avoir été le plus clair possible,

Merci beaucoup pour votre aide,

Pour mettre les résultats à la file, change cette ligne

Sheets("TEST_RESEAU").Cells(compteur, 1) = Sheets("TEMP_MONITORING").Cells(ligne - 1, 1)

en

derligne=Sheets("TEST_RESEAU").Cells(rows.count, 1).end(xlup).row+1
Sheets("TEST_RESEAU").Cells(derLigne, 1) = Sheets("TEMP_MONITORING").Cells(ligne - 1, 1)

Fais alors une boucle sur ta macro.

Bonsoir, merci pour votre réponse.

Cette modification n'a malheureusement aucun effets, j'ai remplacer la ligne par votre code, mais en faisant :

Sub IMPORT_TEST() Dim URL_ETH As String For i = 2 To 21 URL_ETH = Feuil2.Cells(i, 27).Value Sheets("TEMP_MONITORING").Cells.Clear With Sheets("TEMP_MONITORING").QueryTables.Add(Connection:="URL;" & URL_ETH & "" _ , Destination:=Sheets("TEMP_MONITORING").Range("$A$1")) .Name = "BIG BROTHER ALL" .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 Next i compteur = 0 For ligne = 1 To 1000 If Left(Sheets("TEMP_MONITORING").Cells(ligne, 1), 6) = "Status" Then compteur = compteur + 1 derligne = Sheets("TEST_RESEAU").Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets("TEST_RESEAU").Cells(derligne, 1) = Sheets("TEMP_MONITORING").Cells(ligne - 1, 1) If compteur = 5 Then Exit For End If Next End Sub

Je n'ai que le dernier résultat qui s'affiche sur ma page TEST_RESEAU en A2.

Bon ben, sans fichier html je ne pourrai pas aller plus loin ! à moins que tu ne puisses nous faire une copie du fichier source.