Oggi, dato che mi diletto, vi posto una ruotine che serve per scaricare i dati EOD sul proprio foglio excel direttamente da yahoo.finance
Ciò è utile, ad esempio, per aggiornare fogli di calcolo come LTS.
Dovrete leggervi il codice ed adattarlo alle vs esigenze.
Eccovi il codice
------------------------------------------------------------------------------
Sub GetData()
Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim qurl As String
Dim i As Integer, iMax As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Set DataSheet = ActiveSheet
For iMax = 0 To 1000 Step 200
i = 7 + iMax
If Cells(i, 1) = "" Then
GoTo stopHere
End If
qurl = "http://download.finance.yahoo.com/d/quotes.csv?s=" + Cells(i, 1)
i = i + 1
While Cells(i, 1) <> "" And i < iMax + 207
qurl = qurl + "+" + Cells(i, 1)
i = i + 1
Wend
qurl = qurl + "&f=" + Range("C2")
Range("c1") = qurl
QueryQuote:
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("N7"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
Range("N7:N207").Select
Selection.TextToColumns Destination:=Range("N7"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1))
Range("N7:W207").Select
Selection.Copy
Cells(7 + iMax, 3).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
' Range("N7:W207").Select
' Selection.ClearContents
Next iMax
With ThisWorkbook
For Each nQuery In Names
If IsNumeric(Right(nQuery.Name, 1)) Then
nQuery.Delete
End If
Next nQuery
End With
'turn calculation back on
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
' Range("C7:H2000").Select
' Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
' OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
' Columns("C:C").ColumnWidth = 25.43
' Range("h2").Select
stopHere:
End Sub
