Nachtrag:

Damit ein möglicher Helfer hier schnell das Szenario simulieren kann, hier nochmal schnell funktionsfähiger Code.

- Tritt bei euch das oben beschrieben Problem auf?

Vielen Dank!

Sub DownloadKurse()

Dim startdate, enddate As Date
Dim aktie(3) As String


' Start- und Enddatum festlegen "YYYY-MM-DD"
startdate = "2011-01-01"
enddate = "2011-12-31"

'Ausschalten der Sichtbarkeit und Berechnungen während Download
Application.ScreenUpdating = False

aktie(3) = "CGYK.DE"
aktie(2) = "DAI.DE"
aktie(1) = "SG0T41.SG"

' Aufrufen der Routine zum Kursabruf
Call GetPrices(aktie, startdate, enddate)

'Aktivierung der Sichtbarkeit
Application.ScreenUpdating = True

' Setzen des sichtbaren Sheets
ThisWorkbook.Sheets("Tabelle1").Select

MsgBox ("Kursdownload via Yahoo erfolgreich beendet!")

End Sub

Sub GetPrices(aktie, startdate, enddate)

' GetPrices arbeitet mit zwei Sheets:
' 1. "GetPrices"
' 2. "GetPrices2"
' "GetPrices" dient als dauerhafte Speicherstelle für den Abruf anderer Module
Dim sheet1, sheet2 As String
sheet1 = "Tabelle1"
sheet2 = "Tabelle2"

' Meldungen deaktivieren
Application.DisplayAlerts = False

'Sheets vorbereiten
    Sheets(sheet1).Select
    Cells.Select
    Selection.ClearContents
    Sheets(sheet2).Select
    Cells.Select
    Selection.ClearContents

'Formatierung von sheet1
    Sheets(sheet1).Select
    Cells.Select
    Selection.NumberFormat = "#,##0.00"
    Columns("A:A").Select
    Selection.NumberFormat = "m/d/yyyy"

' Deklarierung der Variablen
Dim a, b, c, d, e, f As Integer
Dim i, i2, i3 As Integer ' HilfsIndex-Variablen
Dim g As String
Dim run As Integer
Dim preis As Double
Dim run2, run3 As Date
Dim genlink As String


' Aus "startdate" und "enddate" (Yahoo) auslesen
' Anpassung der Werte von a und d für Link
a = Format(Month(startdate) - 1, "00")
b = Day(startdate)
c = Year(startdate)
d = Format(Month(enddate) - 1, "00")
e = Day(enddate)
f = Year(enddate)
g = "d" 'Intervall = daily

' Datumswerte schreiben
With ThisWorkbook.Sheets(sheet1)
.Range("A1").Value = "Date"
run2 = startdate
Do
i2 = DateDiff(g, startdate, run2)
.Range("A1").Offset(i2 + 1, 0).Value = run2
run2 = DateAdd(g, 1, run2)
Loop While run2 <= enddate
End With


' Ermitteln der nötigen Durchläufe, um alle Aktien durchzugehen
run = UBound(aktie)

For i = 1 To run
ThisWorkbook.Sheets(sheet2).Select

'Link erzeugen
genlink = "URL;" & "http://ichart.finance.yahoo.com/table.csv?s=" & aktie(i) & _
"&a=" & a & "&b=" & b & "&c=" & c & "&d=" & d & "&e=" & e & "&f=" & f & "&g=" & g & "&ignore=.csv"
' -> Bsp: http://ichart.finance.yahoo.com/table.csv?s=CIS.F&a=0&b=1&c=2011&d=4&e=9&f=2011&g=d&ignore=.csv

'Historische Kurse abrufen
With ActiveSheet.QueryTables.Add(Connection:=genlink, Destination:=Range("A1"))

.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True

End With 'Query


ThisWorkbook.Sheets(sheet2).Range("A1").Select

Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns _
Destination:=Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, _
Semicolon:=False, _
Comma:=True, _
Space:=False, _
Other:=False

With ThisWorkbook
'Kopieren der Kurswerte in Spalte E in sheet1
For Each zelle In Range("E2:E500")
    Select Case zelle.Value
    Case Is <> ""
        i2 = DateDiff(g, startdate, zelle.Offset(0, -4).Value)
            .Sheets(sheet1).[a1].Offset(i2 + 1, i).Font.ColorIndex = 1
            .Sheets(sheet1).[a1].Offset(i2 + 1, i).Value = zelle.Value
    End Select
Next zelle

'Ergänzung der "leeren" Stellen in sheet1
For i3 = 2 To DateDiff(g, startdate, enddate)
    If .Sheets(sheet1).[a1].Offset(i3 + 1, i).Value = "" Then
        .Sheets(sheet1).[a1].Offset(i3 + 1, i).Font.ColorIndex = 3
        .Sheets(sheet1).[a1].Offset(i3 + 1, i).Value = .Sheets(sheet1).[a1].Offset(i3, i).Value
    End If
Next

' Statt "Close" im Titel, soll als Titel Variable aktie stehen
.Sheets(sheet1).[a1].Offset(0, i).Value = aktie(i)
End With 'ThisWorkbook

' Löschen der Abfragewerte
Range(Selection, Selection.End(xlDown).End(xlToRight)).Select
Selection.QueryTable.Delete
Selection.ClearContents

Next i

' Leeren von sheet2
Sheets(sheet2).Select
Cells.Select
Selection.ClearContents
    
'nur diese Spalte ist makiert, nicht gesamter Bereich
Sheets(sheet2).Select
Sheets(sheet2).Range("A1").Select
Sheets(sheet1).Select
Sheets(sheet1).Range("A1").Select

End Sub