URLから変数名にURLを渡しても正しいウェブサイトには移動しないデータ

Question

このコードは基本的には正しく動作していますが、何らかの理由でデータを引き出すことはできません。私は、XとURLを使用して移動し、毎回変更されたが、最初のクエリからデータを挿入し続けると、Name_of_Person変数が変化していきます。理由は何ですか？

Sub Search_People() 

Dim Name_Of_Person As String 
Dim URL As String 
Dim Dashboard_Sheet As Worksheet 
Set Dashboard_Sheet = ThisWorkbook.Sheets("Dashboard") 
Dim Data_Sheet As Worksheet 
Set Data_Sheet = ThisWorkbook.Sheets("Data") 
Dim Data_Dump As Worksheet 
Set Data_Dump = ThisWorkbook.Sheets("DataDump") 
Dim X As Integer 
Dim Y As Integer 
Dim Last_Row As Long 
Dim Email_Output As Range 
Set Email_Output = Data_Dump.Range("A:A") 
Dim Cell As Range 

Last_Row = Data_Sheet.Cells(Data_Sheet.Rows.Count, 8).End(xlUp).Row 

    For X = 1 To Last_Row + 1 
     Name_Of_Person = Data_Sheet.Cells(2 + X, 8) 
     URL = "URL;" & "https://hn.com/people/" 
     URL = URL & Name_Of_Person & "%40.com" 
      With Data_Dump.QueryTables.Add(Connection:= _ 
      URL, _ 
      Destination:=Data_Dump.Range("A1")) 
      .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 

      Set Cell = Email_Output.Find("Email") 
      Worksheets("Data").Cells(2 + X, 9).Value = Cell 
      End With 
      Data_Dump.Columns("A:A").Select 
      Selection.Delete Shift:=xlToLeft 



    Next X 

End Sub 

Answer 1

Sub Search_People() 

Dim Name_Of_Person As String 
Dim URL As String 
Dim Dashboard_Sheet As Worksheet 
Set Dashboard_Sheet = ThisWorkbook.Sheets("Dashboard") 
Dim Data_Sheet As Worksheet 
Set Data_Sheet = ThisWorkbook.Sheets("Data") 
Dim Data_Dump As Worksheet 
Set Data_Dump = ThisWorkbook.Sheets("DataDump") 
Dim X As Integer 
Dim Y As Integer 
Dim Last_Row As Long 
Dim Email_Output As Range 
Set Email_Output = Data_Dump.Range("A:XFD") 
Dim Cell As Range 


Application.EnableCancelKey = xlDisabled 
Last_Row = Data_Sheet.Cells(Data_Sheet.Rows.Count, 8).End(xlUp).Row 

    For X = 1 To Last_Row 
    On Error Resume Next 

     Name_Of_Person = Data_Sheet.Cells(2 + X, 8) 
      Application.StatusBar = " Pulling Data for... " & Name_Of_Person 
     URL = "URL;" & "https://site/" 
     URL = URL & Name_Of_Person & "site.com" 
      With Data_Dump.QueryTables.Add(Connection:= _ 
      URL, _ 
      Destination:=Data_Dump.Range("A1")) 
      .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 
      Set Cell = Email_Output.Find("Email") 
      Worksheets("Data").Cells(2 + X, 9).Value = Cell 
      Data_Dump.Range("A:A").EntireColumn.Delete 



    Next X 
      Application.StatusBar = False 
End Sub 

このコードは、上記の問題のすべてを解決しました。