Ersetzen von Teilen einer URL mit Wert aus einer Spalte

Question

Ich möchte Datenblätter für Pferde herunterladen.

Die einzige Variable im Makro ist ein Teil der URL.

Ich habe alle Variablen (die Pferde-Nummern) in der Spalte "A" aufgeführt.

Ich möchte ein neues Blatt mit den Informationen von der Website gesammelt, und sammeln Sie dann Informationen wieder unter Verwendung der Zahlen (neue Variable) von der nächsten Zeile in der Spalte "A".

Bisher ist dies der Code, den ich habe:

Sub Makro1() 
' 
' Makro1 Makro 
' 
Dim nummer As String 

nummer = Sheets("Ark1").Range("A1:A10") 

' 
    ActiveWorkbook.Worksheets.Add 
    With ActiveSheet.QueryTables.Add(Connection:= _ 
     "URL;http://195.198.34.45/trav/hast/visa/" & nummer & "/resultat", Destination:=Range _ 
     ("$A$1")) 
     .CommandType = 0 
     .Name = "resultat" 
     .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 = True 
     .WebDisableRedirections = False 
     .Refresh BackgroundQuery:=False 
    End With 
    Columns("D:D").Select 
    ActiveWindow.SmallScroll Down:=21 
    Columns("E:E").Select 
    Range("E22").Activate 
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
    Columns("D:D").Select 
    Range("D22").Activate 
    Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _ 
     TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=True, Semicolon _ 
     :=False, Comma:=False, Space:=False, Other:=True, OtherChar:="/", _ 
     FieldInfo:=Array(1, 2), TrailingMinusNumbers:=True 
End Sub 

User sheet trying to describe problem

Answer 1

ein Satz auf, wie mehrere Abfrage zu handhaben, nicht sicher, was Sie mit jedem Ergebnis tun wollen

Sub Makro1() 
' 
' Makro1 Makro 
' 
    Set ws = ActiveSheet 'sheet containing your numbers in column A 
    ActiveWorkbook.Worksheets.Add 
    For Each nummer In ws.Range("A1:A10") 
    If nummer.Text = "" Then Exit For 
     For Each qt In ActiveSheet.QueryTables 
      qt.Delete 
     Next 
     With ActiveSheet.QueryTables.Add(Connection:= _ 
      "URL;http://195.198.34.45/trav/hast/visa/" & nummer.Text & "/resultat", Destination:=Range("$A$1")) 
      .Name = "resultat" 
      .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 = True 
      .WebDisableRedirections = False 
      .Refresh BackgroundQuery:=False 
      nummer.Offset(0, 1) = ActiveSheet.Cells(21, 1) 
     End With 
    Next 
    Application.DisplayAlerts = False 
    ActiveSheet.Delete 
    Application.DisplayAlerts = True 
End Sub