про импорт данных из WEB страницы

[Volodymyr]

добрый день!
прошу помочь с макросом, который бы импортировал данные со страницы
http://www.avi so.ua/a/cn.aspx?r=609...147467717&pg=1
в эксель.
(в адресе я вставил пробел, он лишний)

конечная задача, импортировать данные со всех страниц на 1 лист в экселе и изменение структуры таблицы (перевод данных с телефоном в столбец "B", и т.д.), но это я постараюсь сделать сам.

спасибо, с уважением,
Владимир.

[Hugo121]

После отработки стандартного вэб-запроса телефоны и так в B.
Запишите это в макрос, потом добавьте цикл от 1 до сколько_нужно_страниц и выгрузку в последнюю+1 заполненную строку.

[motorway]

Этот сайт показан как красный в рейтинге McAfee. А в чем должна состоять помощь? Если полностью все сделать, то тогда это не бесплатно получится...

[Hugo121]

Ничего не правил, только добавил, что сказал выше:

Option Explicit


Sub getdata()
Dim i As Long, r_ As Long

For i = 1 To 8
r_ = Range("A" & Rows.Count).End(xlUp).Row + 1
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.aviso.ua/a/cn.aspx?r=60923&i=-2147467717&pg=" & i, Destination:=Range _
        ("A" & r_))
        .Name = "cn.aspx?r=60923&i=-2147467717"
        .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
        .Refresh BackgroundQuery:=False
    End With
Next
End Sub

[Volodymyr]

я не прошу сделать за меня! У меня есть вопрос по импорту, я его задал. Далее я описал, что я хочу получить в результате, намеков на "сделайте это мне" я не делал.

Я пробовал,
Sub tmp3()
it = 1
tt = 1
Do While it <= 2
If it = 1 Then tt = it * 84
With ActiveSheet.QueryTables.Add(Connect ion:= _
"URL;http://www.aviso.ua/a/cn.aspx?r=60923&i=-2147467717&pg=" & it, _
Destination:=Range("$A$" & it))
.Name = "a/cn.aspx?r=60923&i=-2147467717&pg=" & it
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingAll
.WebTables = """tblList"""
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
it = it + 1
Loop
End Sub

в итоге макрос не запускается.

[Hugo121]

Мой код отработал?
Я его и на чистом файле запускал - ОК.

[Volodymyr]

да, спасибо! Это именно то!

[doober]

Макрос отлично отработал и выбрать телефоны не составляет труда.
Строка идет телефон, в следующем столбце номер