Есть вот такой макрос:
Sub mozg1()
Range("A1").Select
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.aaa/aaa.shtml?1189711", Destination:=Range("A1"))
.Name = "aaa.shtml?1189711"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "46"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub
Помогите с написанием макроса в экселе, хелп.
Код:
Этот макрос осуществляет запрос, по заданному адресу (http://www.aaa/aaa.shtml?1189711) и берет данные из 46-ой таблицы и вставляет их в новый лист экселя.
А нужно сделать следующим образом, чтоб заданный адрес брался из листа 5 например(из ячейки А1) потом цикл (запрос+вставка данных на новый лист) и заново, но адрес уже берется из ячейки А2, короче чтоб адреса запросов брались поочередно с листа 5 из первого столбца. Нужно цикл сделать и переменные описать, борюсь 2-ой день, но никак, ПОМОГИТЕ ! аська 338160622, мыло 5615(собака)inbox.ru. нахожу похожие примеры но что-то никак. Заранее спасибо всем откликнувшимся.
Код:
On Error GoTo ErrHandler
If ActiveWorkbook.ProtectStructure Then
MsgBox "Создание новых листов невозможно", vbCritical, ""
Exit Sub
End If
Application.ScreenUpdating = False ' и т.д. (по необходимости)
With Worksheets(1) 'Укажите рабочий лист с URL адресами
Dim iCell As Range
For Each iCell In .Range(.[A1], .[A65536].End(xlUp))
'Здесь имеет смысл проверить значение ячейки
With Worksheets.Add(, Sheets(Sheets.Count))
With .QueryTables.Add("URL;" & iCell, .[A1])
...
...
...
.WebTables = "46" '?
...
...
...
End With
End With
Next
End With: Exit Sub
ErrHandler:
Application.ScreenUpdating = True
MsgBox Err.Description, vbCritical, Err.Number
If ActiveWorkbook.ProtectStructure Then
MsgBox "Создание новых листов невозможно", vbCritical, ""
Exit Sub
End If
Application.ScreenUpdating = False ' и т.д. (по необходимости)
With Worksheets(1) 'Укажите рабочий лист с URL адресами
Dim iCell As Range
For Each iCell In .Range(.[A1], .[A65536].End(xlUp))
'Здесь имеет смысл проверить значение ячейки
With Worksheets.Add(, Sheets(Sheets.Count))
With .QueryTables.Add("URL;" & iCell, .[A1])
...
...
...
.WebTables = "46" '?
...
...
...
End With
End With
Next
End With: Exit Sub
ErrHandler:
Application.ScreenUpdating = True
MsgBox Err.Description, vbCritical, Err.Number