新しいExcelワークシートを追加するとエラー400が発生する

Question

理想的には、このマクロはそれぞれの会社の情報で新しいタブを作成しますが、新しいタブを作成することにも苦労しています。それは私にエラー400

Sub getStockPrices() 

Dim DataSheet As Worksheet 
Dim EndDate As Date 
Dim StartDate As Date 
Dim Symbol As String 
Dim Interval As String 
Dim qurl As String 
Dim nQuery As Name 
Dim LastRow As Integer 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Application.Calculation = xlCalculationManual 

Sheets("data").Cells.Clear 

Set DataSheet = ActiveSheet 

    StartDate = DataSheet.Range("startDate").Value 
    EndDate = DataSheet.Range("endDate").Value 
    Symbol = DataSheet.Range("ticker").Value 
    Interval = DataSheet.Range("Interval").Value 
    Sheets("data").Range("a1").CurrentRegion.ClearContents 

    qurl = "http://ichart.finance.yahoo.com/table.csv?s=" & Symbol 
    qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _ 
     "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _ 
     Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Interval & "&q=q&y=0&z=" & _ 
     Symbol & "&x=.csv" 

QueryQuote: 
    With Sheets("data").QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets("data").Range("a1")) 
     .BackgroundQuery = True 
     .TablesOnlyFromHTML = False 
     .Refresh BackgroundQuery:=False 
     .SaveData = True 
    End With 

    Sheets("data").Range("a1").CurrentRegion.TextToColumns Destination:=Sheets("data").Range("a1"), DataType:=xlDelimited, _ 
     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ 
     Semicolon:=False, Comma:=True, Space:=False, other:=False 

    Sheets("data").Columns("A:G").ColumnWidth = 12 

End Sub 

マクロを起動するフィールドを持つシートの画像を与えるように、このマクロの終わり、。

私は、株式相場、日付範囲、および日または週価格に入れて、それがヤフーに呼び出し、この情報を「データ」タブに入力します。私は分析するためにこれを数十の企業で実行する必要がある状況がありますが、私が今設定した方法に基づいて、毎回新しいシートを作成してデータをコピーする必要があります。

会社のティッカーシンボルと日付範囲のリストをループしてこのコードを実行し、それを新しいシートに置き、会社のティッカーが何であれシートに名前を付けて、次の会社に移動するにはどうすればよいですか？

少なくとも、新しいタブを作成し、ちょうど実行された会社のティッカーに名前を付ける方法。

Answer 1

これは私のスタブです。これは、名前付き範囲呼び出しTickerListを持つCriteriaという名前のシートを見つけることを想定しています。これは株式記号の単一列です。 StartDate、EndDate、およびIntervalは、各シンボルの右側のセルにあります。

Sub getStockPrices() 

    Dim DataSheet As Worksheet 
    Dim CriteriaSheet As Worksheet 
    Dim EndDate As Date 
    Dim StartDate As Date 
    Dim Symbol As String 
    Dim Interval As String 
    Dim qurl As String 
    Dim LastRow As Integer 
    Dim myCell As Range 

    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    Application.Calculation = xlCalculationManual 

    Set CriteriaSheet = ActiveWorkbook.Worksheets("Criteria") 
    ' Iterate through the TickerList range 
    ' creating a new sheet for each entry 
    For Each myCell In CriteriaSheet.Range("TickerList") 
     Symbol = myCell.Value 
     StartDate = myCell.Offset(0, 1).Value 
     EndDate = myCell.Offset(0, 2).Value 
     Interval = myCell.Offset(0, 3).Value 
     With ThisWorkbook 
      Set DataSheet = .Sheets.Add(After:=.Sheets(.Sheets.Count)) 
      DataSheet.Name = Symbol 
     End With 
     qurl = "http://ichart.finance.yahoo.com/table.csv?s=" & Symbol 
     qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _ 
     "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _ 
     Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Interval & "&q=q&y=0&z=" & _ 
     Symbol & "&x=.csv" 
     With Sheets(Symbol).QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets(Symbol).Range("a1")) 
      .BackgroundQuery = True 
      .TablesOnlyFromHTML = False 
      .Refresh BackgroundQuery:=False 
      .SaveData = True 
     End With 

     Sheets(Symbol).Range("a1").CurrentRegion.TextToColumns Destination:=Sheets(Symbol).Range("a1"), DataType:=xlDelimited, _ 
     TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ 
     Semicolon:=False, Comma:=True, Space:=False, other:=False 

    Sheets(Symbol).Columns("A:G").ColumnWidth = 12 
    Next myCell 
    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 
    Application.Calculation = xlCalculationAutomatic 
End Sub