Import multiple page web chacune dans une nouvelle feuille
Résolu
Goth!er
Messages postés
15
Date d'inscription
Statut
Membre
Dernière intervention
-
Goth!er Messages postés 15 Date d'inscription Statut Membre Dernière intervention -
Goth!er Messages postés 15 Date d'inscription Statut Membre Dernière intervention -
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.
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 dans word - Guide
- Web office - Guide
- Comment traduire une page web - Guide
- Capturer une page web complète - Guide
1 réponse
yg_be
Messages postés
23541
Date d'inscription
Statut
Contributeur
Dernière intervention
Ambassadeur
1 584
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
Merci