VBA Run-Time Error 1004 After 29738 Rows - excel

Question

Good Day everyone. I'm new to VBA and was working with the following code to figure out how to query multiple tables. I would like the code to go to 100000 rows but I wanted to see how far it could actually run. Sadly, after the 29714th row, it gave me : Run-Time error 1004 'Application-defined or object-defined error'. I don't have a clue as to what is wrong other than the loop parameters might be too big. Any ideas?
Sub Data()
Dim qtb As New QueryTable
Dim url1 As String
Dim i As Long
For i = 2 To 540602 Step 24
url1 = Sheet2.Range("A" & i)
Set qtb = Sheet2.QueryTables.Add(Connection:="URL;" & url1, Destination:=Range("B" & i))
qtb.WebTables = "5"
qtb.FieldNames = True
qtb.RowNumbers = False
qtb.FillAdjacentFormulas = False
qtb.PreserveFormatting = True
qtb.RefreshOnFileOpen = False
qtb.BackgroundQuery = False
qtb.RefreshStyle = xlInsertDeleteCells
qtb.SavePassword = False
qtb.SaveData = False
qtb.AdjustColumnWidth = False
qtb.RefreshPeriod = 0
qtb.WebSelectionType = xlSpecifiedTables
qtb.WebFormatting = xlWebFormattingNone
qtb.WebPreFormattedTextToColumns = True
qtb.WebConsecutiveDelimitersAsOne = True
qtb.WebSingleBlockTextImport = False
qtb.WebDisableDateRecognition = False
qtb.WebDisableRedirections = False
qtb.Refresh BackgroundQuery:=False
Next i
MsgBox ("X")
End Sub

Answer 1

Here's what I came up with. As suggested in the comments, I create the full QueryTable the first time around. After that, I just change the connection to the next cell. The web addresses are now in each row, not every 24. The code steps through them and copies the output to a new sheet for each one. My testing involved only two sites. I don't know how many it will let you create before failing:
Sub Data()
Dim ws As Excel.Worksheet
Dim qtb As QueryTable
Dim url1 As String
Dim i As Long
Set ws = ActiveSheet 'or ws if you prefer
For i = 2 To 3 'links are in each row
url1 = ws.Range("A" & i)
If i = 2 Then
Set qtb = ws.QueryTables.Add(Connection:="URL;" & url1, Destination:=ws.Range("B1"))
With qtb
.WebTables = "5"
.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
Else
qtb.Connection = "URL;" & url1
qtb.Refresh BackgroundQuery:=False
End If
ws.Copy after:=ws.Parent.Worksheets(ws.Parent.Worksheets.Count)
ActiveSheet.Columns(1).EntireColumn.Delete
Next i
End Sub