Replacing parts of an URL with value from a column - vba

Question

I'm trying to download datasheets for horses.
The only variable in the macro is a part of the URL.
I have all the variables (the horses numbers) listed in column "A".
I want to create a new sheet with the information collected from the website, and then collect information again using the numbers (new variable) from next row in column "A".
So far this is the code I have:
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

a proposition on how to handle multiple query, not sure about what you want to do with each result
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