Import Data from websites to worksheet using VBA vertically not horizontally

Question

I know the title may not be too clear. Basically, I have this code. It is importing the data I would like, however it is taking the tables and putting them side by side in the excel sheet. So each table is a certain number of rows and one column. However, I would like this to change so that the imported tables are stacked so they all are in the same column.

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

edited after Jeeped comment

see lines with '<=== comment

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

Answer 2

Adjust the destination row in column A for each iteration of the loop.

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

I've added some optional code to remove the Data, Connections as they are created or in a loop after all hae been retrieved.