将数据从网站导入到使用VBA的工作表中，而不是水平地垂直

我知道标题可能不太清楚。 基本上，我有这个代码。 它正在导入我想要的数据，但它正在把这些表格放在Excel表格中。 所以每个表是一定数量的行和一列。 不过，我想这个改变，以便导入的表格被堆积，所以他们都在同一列。

Sub Macro1() Dim startDate As Date Dim thisDate As Date Dim endDate As Date Dim str2 As String Dim str1 As String Dim str3 As String Dim str As String Dim i As Integer startDate = DateSerial(2004, 1, 1) endDate = DateSerial(2016, 4, 1) str1 = "URL;https://www.census.gov/construction/bps/txt/tb3u" str3 = ".txt" For i = 1 To 300 thisDate = DateAdd("m", i, startDate) str2 = Format(thisDate, "yyyyMM") str = str1 & str2 & str3 With ActiveSheet.QueryTables.Add(Connection:= _ str, _ Destination:=Range("a1")) .Name = "erich." .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 i End Sub 

Answer 1

针对循环的每次迭代调整列A中的目标行。

 Sub Macro1() Dim startDate As Date, thisDate As Date, endDate As Date Dim str As String, str1 As String, str2 As String, str3 As String Dim i As Long, rw As Long startDate = DateSerial(2004, 1, 1) endDate = DateSerial(2016, 4, 1) str1 = "URL;https://www.census.gov/construction/bps/txt/tb3u" str3 = ".txt" For i = 1 To 300 thisDate = DateAdd("m", i, startDate) str2 = Format(thisDate, "yyyyMM") str = str1 & str2 & str3 rw = Range("a" & Rows.Count).End(xlUp).Row - Int(i > 1) 'Adjust the destination row With ActiveSheet.QueryTables.Add(Connection:=str, Destination:=Range("a" & rw)) 'new destination row each loop .Name = "erich." .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 'you might want to get rid of the last connection ActiveWorkbook.Connections.Item(ActiveWorkbook.Connections.Count).Delete Next i 'you might want to get rid of all repeated connections With ActiveWorkbook.Connections Do While CBool(.Count) .Item(.Count).Delete Loop End With End Sub 

我已经添加了一些可选的代码来删除数据，连接，因为它们被创build或在一个循环之后都被检索。

Answer 2

在Jeeped评论后编辑

看到'<===评论”

 Option Explicit Sub Macro1() Dim startDate As Date Dim thisDate As Date Dim endDate As Date Dim str2 As String Dim str1 As String Dim str3 As String Dim str As String Dim i As Integer startDate = DateSerial(2004, 1, 1) endDate = DateSerial(2016, 4, 1) str1 = "URL;https://www.census.gov/construction/bps/txt/tb3u" str3 = ".txt" For i = 1 To 300 thisDate = DateAdd("m", i, startDate) str2 = Format(thisDate, "yyyyMM") str = str1 & str2 & str3 With ActiveSheet.QueryTables.Add(Connection:= _ str, _ Destination:=Range("a" & Rows.Count).End(xlUp)).offset(1) '<=== also edited to skip one row down .name = "erich." .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 .RefreshStyle = xlOverwriteCells '<=== .Refresh BackgroundQuery:=False End With Next i Activesheet.rows(1).delete '<== added in editing. removes first row that has been left empty after the first iteration End Sub