Petit coup de main pour copier mes données web

[alpilon]

Bonjour
Gràce à vous, j'ai bien avancé sur mon idée de récupérer mes données web à partir des liens de l'onglet 'URL', seulement là je bloque de nouveau sur le code du module 1.
je n'arrive pas à lui faire coller les pages entières web les unes sous les autres dans l'onglet 'Données'
actuellement j'ai une redondance sur la première page collée dans l'onget 'Requête'

d'autre part je ne dois pas savoir utiliser
'On Error Resume Next'
si je ne le mets pas j'ai un problème avec
'.Refresh BackgroundQuery:=False'

Pour résumer, mon idée est d'importer avec le bouton 'RecupCotes' dans 'URL' toutes les pages liées aux liens, une par une dans 'Requête'
de les effacer après les avoir coller dans 'Données' les unes sous les autres

j'essaierai ensuite de compiler les différentes macros

merci de votre aide

 

[alpilon]

Re : Petit coup de main pour copier mes données web

Bonjour,

Etonnant, 86 vues pour ne pas répondre à ma demande de coup de main !? Mais peut-être ne suis-je pas assez clair.
Bon, ayant un peu avancé, je retente une version plus light 😉

Dans le fichier joint, j'arrive à charger chaque page de chaque lien de "Url" en colonne C de "Url" avec le bouton 'RécupCotes'
sauf que les données ne gardent pas un cadre constant, puisque selon le nombre d'infos elles se mettent les unes sous les autres, aussi je pense qu'il serait mieux de créer une page par lien
Comment puis-je intégrer ceci
'ActiveWorkbook.Worksheets.Add dans la macro du Module 1 ?

Sub lance_requête()

Dim i As Integer
Dim Chaine As String

Sheets("Url").Range("A1").Select
   On Error Resume Next
For i = 1 To 20

    Chaine = Worksheets("URL").Cells(i, 1).Value
   
    
 
    
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & Chaine, _
        Destination:=Sheets("Url").Range("C" & Range("C1048576").End(xlUp).Row + 1))

        .Name = "Test"
        .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
   Next i
   
End Sub

Merci à vous

 

[tototiti2008]

Re : Petit coup de main pour copier mes données web

Bonjour alpilon,

peut-être, mais pas testé

Sub lance_requête()

Dim i As Integer
Dim Chaine As String

Sheets("Url").Range("A1").Select
   On Error Resume Next
For i = 1 To 20

    Chaine = Worksheets("URL").Cells(i, 1).Value
   
    
  Worksheets.add
    
    With ActiveSheet.QueryTables.Add(Connection:="URL;" & Chaine, _
        Destination:=activesheet.range("A1")

        .Name = "Test" & i
        .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
   Next i
   
End Sub

 

[alpilon]

Re : Petit coup de main pour copier mes données web

Excellent tototiti2008
avec une petite parenthèse de plus après ("A1"))
Merci à toi