'Voraussetzungen:
'Das Makro benötigt definierte Spaltenüberschriften:
'Ticker, Kurs, Vortag, Änderung, Änderung Proz., Kursdatum, Kurszeit
'Die Reihenfolge der Spalten ist beliebig
'Weglassungen vordefinierter Spalten ist möglich
'Als Überschriftenzeile für die Spaltenüberschriften sind die ersten fünf Zeilen erlaubt
'Die definierten Spalten können an beliebiger Stelle im Bereich Spalte A bis Spalte Z angeordnet werden
'Zwischen den vordefinierten Spalten können weitere Spalten eingefügt werden
'Die Symbole für die Wertpapiere findet man bei Yahoo

Public Sub yQuotes()
Dim c As Range
Dim TickerString As String
Dim TickerSplitString() As String
Dim TickerSplitStringKurs As String
Dim TickerSplitStringVortag As String
Dim TickerSplitStringAenderung As String
Dim TickerSplitStringAenderungProz As String
Dim TickerSplitStringKursDatum As String
Dim TickerSplitStringKursZeit As String
Dim UeberschriftenZeile As Integer
Dim TickerAnzahl As Integer
Dim TickerSpalte As Integer
Dim KursSpalte As Integer
Dim VortagSpalte As Integer
Dim AenderungSpalte As Integer
Dim AenderungProzSpalte As Integer
Dim DatumSpalte As Integer
Dim UhrzeitSpalte As Integer
Dim KursString As String
Dim Adresse As String
Dim XML

On Error GoTo Fehler
'Lokalisierung der Tabellenspalten
For Each c In Range("A1:Z5")
    If c.Value Like "Ticker" Then
        UeberschriftenZeile = c.Row
        TickerSpalte = c.Column
    End If
    If c.Value Like "Kurs" Then
        KursSpalte = c.Column
    End If
    If c.Value Like "Vortag" Then
        VortagSpalte = c.Column
    End If
    If c.Value Like "Änderung" Then
        AenderungSpalte = c.Column
    End If
    If c.Value Like "Änderung %" Then
        AenderungProzSpalte = c.Column
    End If
    If c.Value Like "Kursdatum" Then
        DatumSpalte = c.Column
    End If
    If c.Value Like "Kurszeit" Then
        UhrzeitSpalte = c.Column
    End If
Next
'Zusammenfügen der URL
x = x + 1
i = UeberschriftenZeile + 1
While Cells(i, TickerSpalte).Value <> ""
    TickerString = TickerString + Cells(i, TickerSpalte).Value + ","
    i = i + 1
Wend
TickerAnzahl = i - (UeberschriftenZeile + 1)
Adresse = "https://query1.finance.yahoo.com/v7/finance/quote?symbols=" & TickerString
Set XML = CreateObject("MSXML2.ServerXMLHTTP")
    XML.Open "GET", Adresse, False
XML.send
'Auslesen des Textes
KursString = XML.responsetext
'Zerlegen des ausgelesenen Textes
TickerSplitString = Split(KursString, "}")
For i = 0 To TickerAnzahl
    'Auslesen des Kurses
    If KursSpalte > 0 Then
        TickerSplitStringKurs = Split(TickerSplitString(i), "regularMarketPrice"":")(1)
        TickerSplitStringKurs = Left(TickerSplitStringKurs, InStr(TickerSplitStringKurs, ",") - 1)
        TickerSplitStringKurs = Replace(TickerSplitStringKurs, ".", ",")
        Quote = CDbl(TickerSplitStringKurs)
        Cells(UeberschriftenZeile + 1 + i, KursSpalte).Value = Quote
    End If
    'Auslesen des Kurses vom Vortag
    If VortagSpalte > 0 Then
        TickerSplitStringVortag = Split(TickerSplitString(i), "regularMarketPreviousClose"":")(1)
        TickerSplitStringVortag = Left(TickerSplitStringVortag, InStr(TickerSplitStringVortag, ",") - 1)
        TickerSplitStringVortag = Replace(TickerSplitStringVortag, ".", ",")
        Quote = CDbl(TickerSplitStringVortag)
        Cells(UeberschriftenZeile + 1 + i, VortagSpalte).Value = Quote
    End If
    'Auslesen der Änderung zum Vortageskurs
    If AenderungSpalte > 0 Then
        TickerSplitStringAenderung = Split(TickerSplitString(i), "regularMarketChange"":")(1)
        TickerSplitStringAenderung = Left(TickerSplitStringAenderung, InStr(TickerSplitStringAenderung, ",") - 1)
        TickerSplitStringAenderung = Replace(TickerSplitStringAenderung, ".", ",")
        Quote = CDbl(TickerSplitStringAenderung)
        Cells(UeberschriftenZeile + 1 + i, AenderungSpalte).Value = Quote
    End If
    'Auslesen der prozentualen Änderung zum Vortageskurs
    If AenderungProzSpalte > 0 Then
        TickerSplitStringAenderungProz = Split(TickerSplitString(i), "regularMarketChangePercent"":")(1)
        TickerSplitStringAenderungProz = Left(TickerSplitStringAenderungProz, InStr(TickerSplitStringAenderungProz, ",") - 1)
        TickerSplitStringAenderungProz = Replace(TickerSplitStringAenderungProz, ".", ",")
        Quote = CDbl(TickerSplitStringAenderungProz)
        Cells(UeberschriftenZeile + 1 + i, AenderungProzSpalte).Value = Quote
    End If
    'Auslesen des Kursdatums und der Kurszeit
    If UhrzeitSpalte > 0 And DatumSpalte > 0 Then
        TickerSplitStringKursDatum = Split(TickerSplitString(i), "regularMarketTime"":")(1)
        TickerSplitStringKursDatum = Left(TickerSplitStringKursDatum, InStr(TickerSplitStringKursDatum, ",") - 1)
        Quote = TickerSplitStringKursDatum
        Quote = DateAdd("s", Quote + 7200, "1.1.1970")
        Cells(UeberschriftenZeile + 1 + i, DatumSpalte).Value = Quote
        Cells(UeberschriftenZeile + 1 + i, UhrzeitSpalte).Value = Quote
    End If
Next
Set XML = Nothing
Range("A1").Select
Exit Sub
Fehler:
    Quote = 0
    Set XML = Nothing
    Range("A1").Select
End Sub