Sub Aktienscreener1()
Dim Cell As Range
Dim LoHi As Variant
Dim HTMLdoc As Object
Dim n As Long
Dim op As String
Dim oTable As Object
Dim oTables As Object
Dim PageSrc As String
Dim pc As String
Dim pe As Variant
Dim RngBeg As Range
Dim RngEnd As Range
Dim URL As String
Dim yr As String
Dim Wks As Worksheet
Set Wks = ActiveSheet
Set RngBeg = Wks.Range("A2")
Set RngEnd = Wks.Cells(Rows.Count, RngBeg.Column).End(xlUp)
If RngEnd.Row < RngBeg.Row Then Exit Sub
Set HTMLdoc = CreateObject("htmlfile")
With CreateObject("MSXML2.ServerXMLHTTP")
For Each Cell In Wks.Range(RngBeg, RngEnd)
DoEvents
.Open "GET", URL, False
.Send
If .Status <> 200 Then
MsgBox "Error: " & .Status & " - " & .statusText
Exit Sub
End If
PageSrc = .responseText
HTMLdoc.Write PageSrc
HTMLdoc.Close
Set oTables = HTMLdoc.GetElementsByTagName("table")
Set oTable = oTables(0)
pc = oTable.Rows(0).Cells(1).innerText
op = oTable.Rows(1).Cells(1).innerText
yr = oTable.Rows(5).Cells(1).innerText
LoHi = Split(yr, " - ")
Set oTable = oTables(1)
pe = oTable.Rows(2).Cells(1).innerText
Cell.Offset(0, 1).Resize(1, 4).Value = Array(pc, op, LoHi(1), pe)
Next Cell
End With
End Sub