VBA Query Table will not pull data into worksheet after using string for html

Question

I need help, my code will not pull data into the new sheet that it creates from the website. It comes up as blank. It is really frustrating. The query table will not pull the data in after I assigned the string variable "counties" as a website address. I have looked all over the internet and haven't found the answer of how to fix this.

counties = Range("HTML").Offset(x, 0) shows up to equal 08/08001.html which is part of the website address.

    Sub Macro6()

     Dim x As Integer
     Dim counties As String
     For x = 1 To 3

        Sheets("RawData").Select
        counties = Range("HTML").Offset(x, 0)
        Sheets.Add.Name = "DataTemp"

        With ActiveSheet.QueryTables.Add(Connection:="URL;http://quickfacts.census.gov/qfd/states/" & counties & ".html", Destination:=Range("$A$1"))
            .Name = "08001"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingNone
            .WebTables = "3,4,5"
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False

        End With

'This part moves the data from the newly created "DataTemp" sheet into the "Demographics" sheet.

Columns("A:B").Select
ActiveWindow.ScrollColumn = 2
Range("A:B,D:D").Select
Range("D1").Activate
Selection.ClearContents
Range("C1:C63").Select
Selection.Copy
Sheets("Demographics").Select
Cells(6, x + 2).Select
ActiveSheet.Paste
Columns("C:C").EntireColumn.AutoFit
ActiveSheet.Previous.Select
Application.CutCopyMode = False
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

Next x

End Sub

Answer 1

Here is a quick rewrite of your code with the primary intent of removing reliance on .Select and .Activate commands¹ in favor of direct worksheet and cell addressing. It isn't complete but does pull in the first three groups of three tables and should provide a framework on which you can build.

Sub get_County_Census_Data()

    Dim x As Long, lr As Long, nr As Long
    Dim counties As String, sURL As String

    For x = 1 To 3

        sURL = "http://quickfacts.census.gov/qfd/states/×C×.html"
        counties = Worksheets("RawData").Range("HTML").Offset(x, 0) 'e.g. 08/08001
        sURL = Replace(sURL, "×C×", counties)

        On Error GoTo bm_New_TMP_ws  'if DataTemp doesn't exist, go create one
        With Worksheets("DataTemp")
            On Error GoTo 0
            .Cells(1, 1).CurrentRegion.Clear

            With .QueryTables.Add(Connection:="URL;" & sURL, _
              Destination:=.Range("$A$1"))   'associate A1 with the DataTemp worksheet (e.g. .Range not Range)
                .Name = Right(counties, 5)  'unique name to the connection
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = True
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlSpecifiedTables
                .WebFormatting = xlWebFormattingNone
                .WebTables = "3,4,5"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With

            With Worksheets("Demographics")
                nr = Application.Max(6, .Cells(Rows.Count, x + 2).End(xlUp).Offset(1, 0).Row)
            End With
            lr = .Cells(Rows.Count, 3).End(xlUp).Row
            .Cells(1, 3).Resize(lr, 1).Copy _
                Destination:=Worksheets("Demographics").Cells(nr, x + 2)
            With Worksheets("Demographics")
                .Columns(x + 2).EntireColumn.AutoFit
            End With

            'no need to retain this; delete the connection and the worksheet
            Application.DisplayAlerts = False
            .Parent.Connections(.Parent.Connections.Count).Delete
            .Delete
            Application.DisplayAlerts = True
        End With
    Next x

    GoTo bm_Safe_Exit  'skip over the worksheet creation routine

bm_New_TMP_ws:
    On Error GoTo 0
    With Worksheets.Add(After:=Sheets(Sheets.Count))
        .Name = "DataTemp"
    End With
    Resume

bm_Safe_Exit:
    '
End Sub

There really isn't a necessity to delete the DataTemp worksheet every cycle; clearing the data and deleting the connection should be sufficient. However, this demonstrates a method of creating a worksheet 'on-the-fly' repetitively and that may be important to learn.

---

¹ _{See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.}