Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Usine à gaz

XLDnaute Barbatruc
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
 

Pièces jointes

  • html copie.xlsm
    20 KB · Affichages: 12
Dernière édition:
Solution
Bonjour Lionel,

Perso j'utiliserais cette macro :
VB: 
Sub Coller()
Application.ScreenUpdating = False
On Error Resume Next
With Sheets("Coller ici")
    .Cells.Delete 'RAZ
    Application.Goto .[A2]
    .Paste 'coller
    .DrawingObjects.Delete 'supprime les objets
    .Rows(.Cells.Find("Annonces et diffusion", , xlValues).Row & ":" & .Rows.Count).Delete
    .Rows("2:" & .Cells.Find("Services assurés et coûts").Row - 1).Delete
    .Columns(1).ColumnWidth = 190
    .Rows.AutoFit
    With .[A1]
        .Value = "Réseau " & Sheets("Appels").[B5] & " - Conditions des Agents Mandataires"
        .HorizontalAlignment = xlCenter
        .Font.Bold = True
        .Font.Size = 23
    End With
    Application.Goto .[A1], True 'cadrage
End With...
Trier par date Trier par votes

Usine à gaz

XLDnaute Barbatruc
Re-Gérard

J'ai testé
lol : c'est radical car ça ferme carrément le navigateur.

Mais ça ne m'arrange pas car sur le navigateur, j'ai d'autres sites ouverts dont j'ai besoin.
En fait, il y en a 3 autres.
Ce qu'il faudrait, c'est que uniquement l'onglet :
Par exemple, j'ai cliqué sur le lien "https://meilleursreseaux.com/immobilier/mandataires/reseau-20-iad-france.html#services_couts" soit fermé (d'ailleurs il est ouvert 2 fois)

Mais je crois que ce n'est pas possible : Ne t'embêtes pas !
Je ferai sans.
C'est déjà super et rapide comme ça.
Merci Gérard
 
Dernière édition:
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
Avec Ctrl+F4 au lieu de Alt+F4 c'est peut-être mieux :
VB: 
CreateObject("WScript.Shell").SendKeys "^{F4}" 'fermeture de la fenêtre web
 

Pièces jointes

  • html copie(2).xlsm
    31.2 KB · Affichages: 3
Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc
Bjr Gérard , le Forum
Evidemment Gérard ton code fonctionne parfaitement dans le contexte de ma demande et je t'en remercie

Plusieurs tentatives d'intégration dans mon fichier de travail sans succès colonnes A à AA déjà occupées.
J'ai besoin que le code soit exécutable à partir d'un module standard au clic sur cellule "B5" de la feuille.
Et c'est bien plus compliqué que ma première demande car dans mon fichier de travail l'utilisation est bien différente.
J'aurais peut-être du exposer comme dans l'utilisation dans mon fichier pour ne pas y revenir ?
Quoi que, vu le chantier, mon cher Gérard ne s'y serait peut-être pas penché pour me concocter une solution.

Voici le cadre du fonctionnement souhaité dans le cadre du fichier de travail
1 - J'ai besoin que le code se lance à la sélection du réseau (cellule "B5) de Feuil1
VB: 
Private Sub Worksheet_SelectionChange(ByVal R As Range)
'CHOIX AVEC AVEC TARGET
If Not Intersect(R, Range("B5")) Is Nothing Then
Réseau_select.Show
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("b5")) Is Nothing Then
    If Target <> "Conditions Réseau" Then
        LoadExplorer
        [a1].Select
        'Target = "Conditions Réseau"
    End If
End If
End Sub

'ET CODE GERARD DANS UN MODULE STANDARD

2 - à l'ouverture du site, le code dans un module standard est appelé en fin du code "Private Sub Worksheet_Change(ByVal Target As Range)"

Je sais, certainement encore plus compliqué à faire mais...
En cas de possibilité, j'ai tout préparé dans le fichier test joint.
Encore MERCI
 

Pièces jointes

  • html test nouveau.xlsm
    49.2 KB · Affichages: 2
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
Bon finalement ce n'est pas trop compliqué; j'ai adapté le code du module liens :
VB: 
Const Attente1 = 3 / 86400 '3 secondes
Const Attente2 = 1 / 86400 '1 seconde

Sub LoadExplorer()
Dim x$
If ActiveCell = "iad" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-20-iad-france.html#services_couts"
If ActiveCell = "safti" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-35-safti.html#services_couts"
If ActiveCell = "drhouse" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-62-dr-house-immo.html#services_couts"
If ActiveCell = "capifrance" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-9-capi-france.html#services_couts"
If ActiveCell = "megagence" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-30-megagence.html#services_couts"
If ActiveCell = "immoliaison" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-24-immoliaison.html#services_couts"
If ActiveCell = "thedoorman" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-133-the-door-man.html#services_couts"
If ActiveCell = "agentmandataire" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-50-agentmandatairefr.html#services_couts"
If ActiveCell = "bsk" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-8-bsk-immobilier.html#services_couts"
If ActiveCell = "optimhome" Then x = "https://meilleursreseaux.com/immobilier/mandataires/reseau-31-optimhome.html#services_couts"
[A1].Select
If x = "" Then Exit Sub
With Sheets("Coller ici")
    .Cells.Delete 'RAZ
    Application.Goto .[A1]
End With
ThisWorkbook.FollowHyperlink x
Application.OnTime Now + Attente1, "Copier"
End Sub

Sub Copier()
CreateObject("WScript.Shell").SendKeys "^a^c" 'touches Ctrl+A et Ctrl+C
Application.OnTime Now + Attente2, "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
CreateObject("WScript.Shell").SendKeys "^{F4}" 'fermeture de la fenêtre web
End Sub
Chez moi j'ai dû faire passe Attente1 à 3 secondes (mon ordi est connecté à internet par mon téléphone portable).
 

Pièces jointes

  • html test nouveau.xlsm
    50.4 KB · Affichages: 3
Dernière édition:
Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc
Re-Gérard
J'avais commencé à chercher comment faire, sans succès, Evidement lol
Et j'me disais ... Et...
Tu me l'as fait, j'ai pas les mots.
Hyper de chez Hyper MERCI à toi,
Génial !!!

MERCI - MERCI
 
Dernière édition:
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
Je ne comprends pas pourquoi tu utilises une Worksheet_SelectionChange, le double-clic est plus logique :
VB: 
Private Sub Worksheet_BeforeDoubleClick(ByVal R As Range, Cancel As Boolean)
If Not Intersect(R, Range("B5")) Is Nothing Then Cancel = True: Réseau_select.Show
End Sub
Plus besoin de sélectionner A1.
 

Pièces jointes

  • html test nouveau(1).xlsm
    48.5 KB · Affichages: 1
Vote positif 0 Vote négatif

Usine à gaz

XLDnaute Barbatruc
Re-Gérard
Pour faciliter le travail de mes Commerciales et pour qu'elles n'aient pas à se demander : double clic ? - clic droit ? - clic ....

Il n'y a que des clics à faire.
Donc double clic et clic droit bloqués.
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

M
  • Question
XL 2019 Transposer des données d'une feuille vers une autre sous forme de synthèse
Réponses
8
Affichages
182
mromain
S
  • Résolu(e)
XL 2016 Copier/Coller des cellules en multipliant par des cellules sur une autre page
Réponses
3
Affichages
503
migau
N
  • Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
357
Nel'
N
P
  • Question
XL 2021 Code VBA pour copier coller des données de cellules d'une feuille a une autre
Réponses
4
Affichages
538
phoceenjo
P
R
  • Question
Microsoft 365 interagir avec une page web
2
Réponses
18
Affichages
2 K
rafi93
R
M
  • Question
Microsoft 365 Mise en forme de données vers un tableau spécifique
Réponses
9
Affichages
719
Maikales
M
S
  • Question
XL 2016 VBA - copier coller des données d'un onglet vers un nouvel onglet
Réponses
1
Affichages
726
vgendron
R
  • Question
Microsoft 365 VBA copier coller des cellules
Réponses
6
Affichages
797
Phil69970
M
  • Résolu(e)
XL 2016 Copier/Coller case cochée vers feuil2
Réponses
3
Affichages
589
Phil69970
  • Résolu(e)
Microsoft 365 VBA - Coller la valeur d'une cellule d'une autre feuille...
Réponses
11
Affichages
781
13Hubert
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…