Webabfrage > Liste in Spalte A > untereinander

Sub Makro1()
Dim wksListeLinks As Worksheet, lngZeile As Long
Dim strLink As String, strCon As String
Dim wbZiel As Workbook, wksZiel As Worksheet, iCount As Integer
Dim strName As String
Set wksListeLinks = ActiveSheet
With wksListeLinks
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
For lngZeile = 1 To lngZeile 'Startzeile der Liste ggf. anpassen!
iCount = iCount + 1
If wbZiel Is Nothing Then
Application.Workbooks.Add Template:=xlWBATWorksheet
Set wbZiel = ActiveWorkbook
Set wksZiel = wbZiel.Worksheets(1)
Else
Set wksZiel = wbZiel.Worksheets.Add(after:=wksZiel)
End If
strLink = wksListeLinks.Cells(lngZeile, 1)
strCon = "URL;" & strLink
strName = strLink
With wksZiel.QueryTables.Add(Connection:=strCon, _
Destination:=wksZiel.Range("A1"))
.Name = strName
.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
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
If iCount = 50 Then '50 = max. Anzahl Tabellenblätter (Abfragen) pro Arbeitsmappe
'für den Max-Wert sind Werte von 1 bis ca. 250 (Excel 2003) zulässig.
iCount = 0
Set wbZiel = Nothing
End If
Next lngZeile
End Sub