Do...Until Loop in Makro einbauen

Sub Webabfrage()
Sheets("Tabelle1").Select
Application.Run "BLPLinkReset"
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;" & Range("AB578").Value _
, Destination:=Range("AG578"))
.Name = "institutDetails.do?cmd=loadInstitutAction&institutId=123024"
.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
'Überprüfen Inhalt
Dim rng As Range
For Each rng In Range("$AG$10:$AG$825")
If rng.Value = "Abschlußvermittlung (§ 1 Abs. 1a Satz 2 Nr. 2 KWG)" Or rng.Value = " _
Anlageverwaltung (§ 1 Abs. 1a Satz 2 Nr. 11 KWG)" Or rng.Value = "Factoring (§ 1 Abs. 1a Satz 2 Nr. 9 KWG)" Then
Range("$AG$1") = "1"
End If
Next
'Select what to do
For Each rng In Range("$AG$10:$AG$825")
If Range("$AG$1") = "" Then
Dim var As Variant
Dim iRow As Integer, iRowL As Integer
iRowL = Cells(Rows.Count, 1).End(xlUp).Row
For iRow = iRowL To 1 Step -1
var = Application.Match("*BaFin (Link zur Startseite)*", Rows(iRow), 0)
If Not IsError(var) Then
Rows(iRow).Delete
End If
Next iRow
End If
Next
'Delete Useless Content
Range("AG:AG").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="*Factoring*", Operator:=xlOr, _
Criteria2:="*Leasing*"
Range("$AG$1:$AN$887").ClearContents
'Zelle wählen
Range("AG632").Select
'Suchen Transponieren Abs
Dim wks As Worksheet
Dim ZelleStart As Range
Dim DeltaZeile As Long
Dim Bereich As Range, Zeile_L As Long
Set wks = ActiveSheet
DeltaZeile = 54 'Anzeilen, um die die Zellen mit "Abs." nach oben verschoben werden sollen
Set ZelleStart = Selection
'Wordbox ehemalig
With wks
'falls aktiv, dann Autofilter deaktivieren
If .AutoFilterMode = True Then
If .FilterMode = True Then .ShowAllData
.AutoFilterMode = False
End If
'Prüfen von Spalte und Zeile der selektierten Startzelle
If ZelleStart.Column = .Range("$AG$1").Column _
And ZelleStart.Row > DeltaZeile _
And ZelleStart.Cells.Count = 1 Then
'Selektion ist ok
Else
MsgBox "Startzelle für Makro muss einzelne Zelle in Spalte AG sein, " _
& "unterhalb von Zeile " & DeltaZeile, _
vbInformation + vbOKOnly, _
"Selektierte Zelle: " & ZelleStart.Address
Exit Sub
End If
'letzte Datenzeile in Spalten AG:AN
With .Range("AG:AN")
Set Bereich = .Find(after:=.Range("A1"), What:="*", LookIn:=xlFormulas, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
End With
If Bereich Is Nothing Then
MsgBox " Keine Daten in Spalten AG:AN"
Exit Sub
Else
Zeile_L = Bereich.Row
If Zeile_L *Abs.*"
'Inhalt in sichtbaren Zellen löschen
Set Bereich = .Range(ZelleStart.Offset(1, 0), .Cells(Zeile_L, ZelleStart.Column))
Bereich.ClearContents
wks.ShowAllData
wks.AutoFilterMode = False
'leere Zellen löschen
If Application.WorksheetFunction.CountBlank(Bereich) > 0 Then
Bereich.SpecialCells(xlCellTypeBlanks).Delete shift:=xlShiftUp
End If
'neue Letztezeile in Spalte AG
Zeile_L = .Cells(.Rows.Count, ZelleStart.Column).End(xlUp).Row
If Zeile_L *Abs.*", Operator:=xlAnd
Selection.ClearContents
Range("AG578").Select
End Sub