Ten původní dotaz jsem posílal já. Od té doby jsem si trochu posunul level (v Excelu).
Předpokládám, že ten cyklus budeš chtít použít na nějaké vlastní www adresy.
Je důležité zjistit, ve kterém sloupci je "hlavní" obsah načtených dat.
Ten se může měnit podle toho, zda se importuje celá stránka nebo jen vybrané tabulky (označené šipkama v okně importu). Podle toho "hlavního sloupce" se pak dá určit poslední řádek pro vkládání dat pod sebe.
Dál je nutné v úseku With - End With zaměnit řádek .RefreshStyle tak, aby importovaná data šly pod sebe.
Já importuju kde co a často taky chci jen jednorázová data, bez uloženého webového dotazu. Dráždí mě pak, že Excel otravuje s možností aktualizace dat po načtení souboru. Pro to mám v cyklu řádek, kdy se právě uložený web dotaz smaže. Předpoklad je, že v sešitu nejsou žádné další web dotazy, které chceš ponechat. Pak se dá taky na řádek .Name dát cokoliv, třeba "aaaaa".
V kódu je tenhle řádek zapoznámkovaný - je to jen možnost, data budou importovaná na aktuální list (prázdný, jiný než UVOD - s tím se dá ještě taky pohrát, založit si nový, přejmenovat atd., to tam ale není).
Sub import_cyklus()
Dim i As Long, Sloupec As Long
Sloupec = 1 ' zde soucasne sl. na UVOD pro brani www adres a kontrolovaný sl. pro posl.radek
For i = 2 To Worksheets("UVOD").Cells(Rows.Count, Sloupec).End(xlUp).Row
adresa = "$A$" & Cells(Rows.Count, sloupec).End(xlUp).Row + 1
With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.peloton.cz/soutez?tym=" _
& Worksheets("UVOD").Cells(i, Sloupec), Destination:=Range(adresa))
.Name = "soutez?tym=" & Worksheets("UVOD").Cells(i, Sloupec)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertEntireRows
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage ' zde import cele stranky
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
' ActiveWorkbook.Connections(1).Delete
Next i
End Sub
Tento kód jsem ale netestoval, zkoušel jsem jen části a s jinou www.
citovat