如何将Querytables结果放在同一张表上

Question

当一些数据集包含100条记录时，我将数据从一个限制数据显示的网站提取到75行 （为什么所有记录都没有选项）？

我可以安排我的循环来创建一个新的工作表，但这会增加更多的工作，因为我必须点击最多50张才能将这些工作表合并为一个。

到目前为止，我的脚本提取数据，我设置了一个计数器来抵消
的位置 结果所以没有被覆盖。然而，在脚本完成后，我最终得到了 在一种情况下，1500个空白行，然后是数据集的最后几行。所以基本上我得到1000个元素数据集的最后75行左右（在一个案例中为3） 不知道我在这里缺少什么。 Querytables是否始终将链接数据放在$ A $ 1中？

代码：

Sub getHistoricalData()
Dim sheetname As String, url As String
Dim x_wsnames As Range
Dim ws As Worksheet, destinationRange As Range
Dim fillRange As Range, cell As Range, startCell As Range, endCell As Range
Dim operationalRange As Range, max As Integer
Dim last_objid As Integer, m As Integer
Dim startPage As Boolean, divider As String
On Error Resume Next

For Each x_wsnames In Sheets("data").Range("B2:B11")
'url = x_wsnames.Offset(0, 2).Value
max = x_wsnames.Offset(0, 2).Value
sheetname = x_wsnames.Value
'  Sheets.Add.Name = sheetname
Sheets(sheetname).Select
  Set ws = Sheets(sheetname)
  Select Case sheetname
    Case "A"
         position = "one"
    Case "B"
        position = "two"
    Case "C"
        position = "three"
    Case "D"
    position = "four"
  Case "E"
    position = "five"
  Case "F"
    position = "six"
   Case "G"
    position = "seven"
  Case "H"
    position = "eight"
  Case "I"
    position = "nine"
  Case "J"
    position = "ten"
End Select
Debug.Print "Processing cycleThroughWorksheets() " & sheetname

m = 0
For i = 1 To max
   url = "http://dataplace/search?category=type&dataType=historical&locations=ALL&d-112233-w=" & i & "&filter=" & divider

'Debug.Print i, url
If i = 1 Then
    Set destinationRange = Range("$A$1")
    Debug.Print destinationRange.Address
Else
    m = m + 75
    Set destinationRange = Range("$A$" & m)
    Debug.Print destinationRange.Address
End If
With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;" & url, destination:= _
    destinationRange)
    .Name = sheetname
    .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
Next


Next 
End Sub