エクセルのセルにネット上の特定の情報を自動的に反映させる方法を教えてください。
やりたいことは、「エクセル上の4桁の株価コードに対応する、最新の株価をネットから持ってきて、別のセルに表示する」ということです。具体的には、セルA1に「７２０３」という数字があった場合、日経の該当ページ（http://company.nikkei.co.jp/index.cfm?scode=7203）から、トヨタ自動車の株価を拾ってきて、A2に表示するようなものです。（株価が分かるのであれば、日経にはこだわりません。）

こちらのページ（http://www15.ocn.ne.jp/~range/menu/menu011_01.html）に紹介されているものをより限定した機能で使えればいいです。私はVBAに関してはド素人なので、そのつもりで説明をしていただければ助かります。よろしくお願いします。

60pt

要は、既存のマクロは利用できないので、株価のみを取り出すマクロに修正したいということですね？

日経の話が先にあり、その後でYahooのデータを基にしたちゃんと動くマクロが出ていたので、混乱してしまいました。

「多く」の単位が分かりませんが、もし100件以上とすると、マクロで動かすには少々時間がかかりますので、やはり日経で持株チェックに入れておいて、画面に出しておいてから、コピー＆ペーストするのがお勧めですが。。。

件数が少ないという前提で、マクロを載せておきます。なお、１度目と２度目で仕様が違っていますので、どちらかというと２度目に合わせておきました。

　最初の質問：A1=銘柄コード、A2=株価

　二度目の回答：A列が銘柄コード、B,C列が何かのデータ？

　マクロ仕様：A列が銘柄コード、２行目A2から始まる。株価は、E2、E3・・・へ入れる。

Option Explicit

Sub 株価チェック()

    Const TargetRow As String = "E"     '★株価を入れる列
    Const YAHOO_1 As String = "URL;http://quote.yahoo.co.jp/q?s="
    Const YAHOO_2 As String = "&d=v1&k=c3&h=on&z=m"
    Dim code As String
    Dim url As String
    Dim table_num As Integer
    Dim i As Integer
    Dim MySheet As Worksheet
    Dim NewSheet As Worksheet
    
    Application.ScreenUpdating = False
    
    Set MySheet = ActiveSheet
    MySheet.Copy before:=Sheets(1)
    Set NewSheet = ActiveSheet
    
    i = 0
    Do
        
        code = Range("A2").Offset(i, 0).Value
        url = YAHOO_1 & code & YAHOO_2
        table_num = 10            '★銘柄数が多いときは15にしておけば速くなる
        
        Do
            Columns("N:Z").Delete Shift:=xlToLeft
            
            With ActiveSheet.QueryTables.Add(Connection:= _
                url, Destination:=Range("N1"))
                .RefreshStyle = xlInsertDeleteCells
                .AdjustColumnWidth = False
                .WebSelectionType = xlSpecifiedTables
                .WebFormatting = xlWebFormattingNone
                .WebTables = table_num
                .Refresh BackgroundQuery:=False
            End With
            table_num = table_num + 1
        Loop Until Range("N1").Value = "コード" Or table_num = 20
    
        Range("D2").Offset(i, 0).Value = Range("R2").Value
        With Range("N1:V3")
            .ClearContents
            .QueryTable.Delete
        End With
        i = i + 1
    Loop Until Range("A2").Offset(i, 0).Value = ""
    
    Range("D2", "D" & (2 + i - 1)).Copy
    MySheet.Range(TargetRow & "2").PasteSpecial Paste:=xlPasteValues, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True
    
    MySheet.Select
    Range("A1").Select
    Application.ScreenUpdating = True
    Set NewSheet = Nothing
    Set MySheet = Nothing
        
End Sub

★の２箇所は変更してください。

最初の★：書かせる列

次の★：Yahoo上の株価があるHTML内でのテーブルの場所。今日現在では15番目でした。→人によって違うかも知れません。

テーブルを上から順になめていって、「コード」というタイトルが出たら、それを株価が入っている場所としています。

元々のコーディングは、「タツ」さんに帰属します。