Schleife in Makro einbauen

Option Explicit
Public Sub Main()
Dim objIEApp As Object
Dim objIEDoc As Object
Dim objTab As Object
Dim lngCount As Long
Dim lngCalc As Long
Dim lngTMP As Long
Dim lngRow As Long
On Error GoTo Fin
With Application
.ScreenUpdating = False
.EnableEvents = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
.DisplayAlerts = False
End With
With Tabelle2
lngCount = IIf(Len(.Cells(.Rows.Count, 1)), _
.Rows.Count, .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
With ThisWorkbook.Worksheets("Tabelle1")
Set objIEApp = CreateObject("InternetExplorer.Application")
objIEApp.Visible = False
For lngCount = 1 To lngCount
objIEApp.Navigate Tabelle2.Cells(lngCount, 1).Text
Do: Loop Until objIEApp.Busy = False
Do: Loop Until objIEApp.Busy = False
Set objIEDoc = objIEApp.Document
Do: Loop Until objIEDoc.ReadyState  4
lngRow = IIf(Len(.Cells(.Rows.Count, 1)), _
.Rows.Count, .Cells(.Rows.Count, 1).End(xlUp).Row) + 1
For Each objTab In objIEApp.Document.all
If objTab.className = "this-week" And objTab.nodeName = "SPAN" Then
Tabelle1.Cells(lngRow, 1) = CLng(objTab.innerText)
ElseIf objTab.className = "info-title" And objTab.nodeName = "SPAN" Then
Tabelle1.Cells(lngRow, 2) = objTab.innerText
lngRow = lngRow + 1
ElseIf objTab.className = "info-artist" And objTab.nodeName = "SPAN" Then
Tabelle1.Cells(lngRow, 3) = objTab.innerText
End If
Next objTab
Next lngCount
.Range("A1").Value = "Platz"
.Range("B1").Value = "Titel"
.Range("C1").Value = "Interpret"
.Columns("A:C").AutoFit
End With
Fin:
objIEApp.Quit
Set objIEDoc = Nothing
Set objIEApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = lngCalc
.DisplayAlerts = True
End With
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub