Import multiple page web chacune dans une nouvelle feuille

Résolu/Fermé

Goth!er Messages postés 15 Date d'inscription jeudi 10 novembre 2016 Statut Membre Dernière intervention 25 avril 2018 - Modifié le 7 nov. 2017 à 14:13
Goth!er Messages postés 15 Date d'inscription jeudi 10 novembre 2016 Statut Membre Dernière intervention 25 avril 2018 - 7 nov. 2017 à 16:08

Bonjour le forum,

Quelqu'un aurait la solution pour importer le contenu de plusieurs urls de ma feuille et que pour chaque Url, Excel crée une nouvelle feuille dédiée ?
Actuellement mon code me permet de charger toutes les données à la suite les unes des autres juste en dessous de mes urls.

Sub test1()

Sheets("Urls").Select
    ActiveCell.Select
  
Dim I As Long, A As String
' declaring variables
With ActiveSheet
    I = 2
    Do
        A = .Cells(I, 1).Value
        If A <> "" Then
            lrc = .Cells(Rows.Count, "A").End(xlUp).Row 'last row in C column
            With ActiveSheet.QueryTables.Add(Connection:= _
                "URL;" & A, Destination:=Cells(lrc + 1, "A"))
                .Name = I
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertEntireRows
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlAllTables
                .WebFormatting = xlWebFormattingNone
                '.WebTables = "1,2"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
        End If
        I = I + 1
    Loop Until A = ""
End With

A voir également:

Import multiple page web chacune dans une nouvelle feuille
Darkino nouvelle adresse - Guide
Supprimer une page word - Guide
Traduire une page web - Guide
Instagram web - Guide
Flixcord nouvelle adresse - Guide

1 réponse

Réponse 1 / 1

yg_be Messages postés 22707 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 19 avril 2024 1 471
7 nov. 2017 à 15:56

bonjour, suggestion:

Sub test1()
Dim nouvsh As Worksheet

Sheets("Urls").Select
    ActiveCell.Select
  
Dim I As Long, A As String
' declaring variables
With ActiveSheet
    I = 2
    Do
        A = .Cells(I, 1).Value
        If A <> "" Then
            Set nouvsh = Worksheets.Add(, Worksheets(Worksheets.Count))
            nouvsh.Name = "URL" & CStr(I)
            'lrc = .Cells(Rows.Count, "A").End(xlUp).Row 'last row in C column
            With ActiveSheet.QueryTables.Add(Connection:= _
                "URL;" & A, Destination:=nouvsh.[A1])
                .Name = I
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertEntireRows
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlAllTables
                .WebFormatting = xlWebFormattingNone
                '.WebTables = "1,2"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
        End If
        I = I + 1
    Loop Until A = ""
End With
End Sub

Goth!er Messages postés 15 Date d'inscription jeudi 10 novembre 2016 Statut Membre Dernière intervention 25 avril 2018
7 nov. 2017 à 16:08

Ca Marche nickel !!!

Merci

Discussions similaires

[PIX] Commencer chaque poème sur une nouvelle page

comment donner les droits sur fichier partage

connection ok mais aucune page ne s'affiche

Discussions similaires

Newsletters