XL 2021 Coller des données d'une page web OUVERTE vers feuille Excel

[Usine à gaz]

Bonjour à toutes et à tous,
Je vous souhaite un beau WE "calme et tranquille"

Je n'arrive pas à résoudre mon besoin et, comme d'habitude, j'en appelle à nos Ténors

Voici mon souci :
J'ai besoin à certains moments de copier les infos d'une page web "OUVERTE" après clic lien OUVERTURE SUR GOOGLE CHROME

Pour l'exemple, à coller dans fichier joint feuille "Coller ici" - J'ai fait des recherches et tentatives sans y parvenir
Important : le site "meilleursreseaux.com" présente toujours la page de la même façon, quel que soit le lien utilisé
Après la présentation des conditions, il y a toujours ensuite la rubrique "Annonces et diffusion"
J'ai donc besoin de copier tout le texte après "Services assurés et coûts" et jusqu'avant "Annonces et diffusion"

J'ai tenté également avec : Données > A partir du web >
sans y parvenir mais ce serait trop long car j'ai besoin que ce soit rapide

Je joins un petit fichier test et je continue mes recherches,
Merci à toutes et à tous

 

[sylvanu]

Bonjour Lionel,

mais ce serait trop long car j'ai besoin que ce soit rapide

Que signifie "rapide" ? Une à deux seconde c'est rapide ?
Si oui un essai en PJ.
On clique sur une cellule A17:A26, les données sont collées en feuille "Coller ici", le temps d'exécution est donné en A16, pour informations.

 

[Usine à gaz]

Bjr sylvanu

Merci pour le retour et ce bel essai super bien.

Evidemment "Usine à Gaz" oblige, ce que je fais n'est jamais simple lol
Je vais piocher la chose et je reviendrai .....

Super ! C'est super ce que tu as fait?
Je te remercie,

 

[Usine à gaz]

Re-Bjr @sylvanu

Je n'avais pas vu que tu avais utilisé Power Query.
Malheureusement, je ne connais du tout, ne m'en étant jamais servi.
Je crains que ça créé des soucis dans mes fichiers déjà compliqués.

Dommage. Je garde ton fichier que je trouve super mais que, certainement à cause de Power Query, je ne parviens déjà pas à adapter comme je le souhaite.
Toutefois, si j'avais réussi, je n'aurai pas pris le risque d'intégrer dans mes fichiers de travail.

Merci pour ton travail, je conserve...

 

[Cousinhub]

Bonsoir,
Je peux te confirmer que Sylvanu( Excel 2007), ne peut, ni n'utilise Power Query....
Ce n'est pas parce qu'il y a "QueryTables", que c'est forcément du PQ...
Et c'est quoi, cet "à-priori", vis à vis de PQ?
Bonne soirée

 

[Usine à gaz]

Bjr Cousinhub

Merci pour le retour et si ce n'est pas du Power Query, je vais voir plus avant pour tenter d'adapter.
Toutefois, il y a une requête qui y ressemble...

'Et c'est quoi, cet "à-priori", vis à vis de PQ"
Ce n'est pas un a priori genre "négatif"
Simplement que je ne l'ai jamais utilisé et que je n'ai de temps pour l'apprendre ... avant longtemps

 

[Cousinhub]

Re-,
Ce n'est pas parce ce que "ça ressemble", que c'en est...
PS, comme tout le monde, même quand VBA est sorti, personne n'avait utilisé "ça"...

 

[sylvanu]

Re,
"Query" veut dire requête"
QueryTables est simplement une table de requête.
PowerQuery est un puissant outil basé sur des requêtes, d'où son petit nom.

QueryTables.Add method (Excel)

Office VBA reference topic

learn.microsoft.com

 

[job75]

Bonjour Lionel, sylvanu, Cousinhub, le forum,

Un essai qui utilise Application.OnTime et l'envoi des touches Ctrl+A et Ctrl+C :

Const Attente1 = 2 / 86400 '2 secondes
Const Attente2 = 1 / 86400 '1 seconde

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, [A17:A26]) Is Nothing Then Exit Sub
Cancel = True
With Sheets("Coller ici")
    .Cells.Delete 'RAZ
    Application.Goto .[A1]
End With
ThisWorkbook.FollowHyperlink Target(1, 2).Hyperlinks(1).Address
Application.OnTime Now + Attente1, Me.CodeName & ".Copier"
End Sub

Sub Copier()
CreateObject("WScript.Shell").SendKeys "^a^c" 'touches Ctrl+A et Ctrl+C
Application.OnTime Now + Attente2, Me.CodeName & ".Coller"
End Sub

Sub Coller()
On Error Resume Next
With Sheets("Coller ici")
    .Paste 'coller
    .DrawingObjects.Delete 'supprime les objets
    .Rows(.Cells.Find("Annonces et diffusion", , xlValues).Row & ":" & .Rows.Count).Delete
    .Rows("1:" & .Cells.Find("Services assurés et coûts").Row - 1).Delete
    .Columns(1).ColumnWidth = 255
    .Rows.AutoFit
    Application.Goto .[A1], True 'cadrage
End With
AppActivate Application.Caption 'active Excel
End Sub

Double-clic dans la plage A17:A26.

Si la copie ne fonctionne pas correctement augmenter les durées d'attente Attente1 et Attente2.

A+

 

[Usine à gaz]

Bonjour Gérard , Bonjour sylvanu , Bonjour Cousinhub , Bonjour le Forum

Merci Gérard, je vais tester dès que j'ai un moment dans la journée et je reviendrai...

 

[Usine à gaz]

Re Gérard
Je n'ai pas pu résister = j'ai testé...
Nickel
Jamais simple chez moi lol
Par exemple, j'ai cliqué sur le lien "https://meilleursreseaux.com/immobilier/mandataires/reseau-20-iad-france.html#services_couts"
Est-il possible de refermer la page html (navigateur), quel que soit le lien cliqué, après la copie dans le fichier Excel ?
Si pas possible ) = Pas grave

 

[job75]

Est-il possible de refermer la page html (navigateur), quel que soit le lien cliqué, après la copie dans le fichier Excel ?

Avec les moyens que j'utilise je ne pense pas.

 

[Usine à gaz]

Re-Gérard
OK, je m'en passerai...
C'est déjà super

 

[job75]

Bon on peut fermer le fichier web par l'envoi des touches Alt+F4 :

Sub Coller()
On Error Resume Next
With Sheets("Coller ici")
    .Paste 'coller
    .DrawingObjects.Delete 'supprime les objets
    .Rows(.Cells.Find("Annonces et diffusion", , xlValues).Row & ":" & .Rows.Count).Delete
    .Rows("1:" & .Cells.Find("Services assurés et coûts").Row - 1).Delete
    .Columns(1).ColumnWidth = 255
    .Rows.AutoFit
    Application.Goto .[A1], True 'cadrage
End With
CreateObject("WScript.Shell").SendKeys "%{F4}" 'fermeture du fichier web
End Sub

 

[Usine à gaz]

Re-Bjr Gérard
Merci pour ce nouveau fichier.
Je vais tester dès que j'ai un moment dans la journée et je reviendrai...