Hallo Experten Team,

und wieder habe ich ein Problem.

Ich habe eine do while Schleife. Diese bricht aber nicht ab, wenn die letzte Zelle leer ist.
Ich erhalte immer den Fehlerhinweis

Laufzeitfehler 1004: [DataFormat.Error] Ungültiger URI: Der Hostname konnte nicht analysiert werden.
Siehe auch in beiliegender Datei im Modul 8
https://www.herber.de/bbs/user/170357.xlsm

Wäre Spitze, wenn mir jemand einen Tipp hätte. Ich habe schon alles mögliche ausprobiert. Es kommt aber immer der gleiche Fehler.

Sub gesamt_test()

Worksheets("start").Select


For Each wks In Worksheets
Application.DisplayAlerts = False
If wks.Name > ActiveSheet.Name _
And wks.Name > "URL" Then wks.Delete
Next

Dim Qus As WorkbookQuery

For Each Qus In ActiveWorkbook.Queries
Qus.Delete
Next

Dim Standort As Variant
Dim website As String
Dim Zeile As Double

Const Spalte As Integer = 1 'Soll in Spalte A nachsehen
Zeile = 2 'Startwert


With Worksheets("Start")
Do While .Cells(Zeile, Spalte) = "" 'solange in der Zelle was steht ausführen
'Do 'funktioniert nicht
Standort = ActiveWorkbook.Sheets("URL").Range("A" & Zeile)
website = ActiveWorkbook.Sheets("URL").Range("B" & Zeile)

ActiveWorkbook.Queries.Add Name:=Standort, Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Quelle = Web.Page(Web.Contents(""" & website & """))," & Chr(13) & "" & Chr(10) & " Data1 = Quelle{1}[Data]," & Chr(13) & "" & Chr(10) & " #""Geänderter Typ"" = Table.TransformColumnTypes(Data1,{{""Column1"", type text}, {""Column2"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Geänderter Typ"""
ActiveWorkbook.Worksheets.Add.Name = Standort
Sheets(Standort).Select

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & Standort & ";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [" & Standort & "]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_Query__" & Standort
.Refresh BackgroundQuery:=False
End With

'Spaltenüberschriften anpassen
ActiveSheet.Range("A1").Value = "Tag"
ActiveSheet.Range("B1").Value = "Zeit"

'Zurück zur Basis
Sheets("start").Select
Range("A1").Select

Zeile = Zeile + 1

'Loop While Cells(Zeile, Spalte) = "" 'funktioniert nicht
'If .Cells(Zeile, Spalte).Value = "" Then 'funktioniert nicht
' Exit Do
'End If

Loop
End With

End Sub


Grüße
Günther