第一張表為「清單」，設定你要抓取的股票清單，第一列為股號，第二列以後依序為你的股票代號
新增一個模組
SUB TEST()
Dim 股號 As String
Dim 查詢起始日 As Date
查詢起始日 = sheet1.Cells(1, 4)
For i = 2 To sheet1.Cells(Rows.Count, 1).End(xlUp).Row
股號 = sheet1.Cells(i, 1).Value
On Error Resume Next
If Sheets(股號) Is Nothing Then '指定的工作表不存在
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = 股號
End If
Dim QT As QueryTable
Dim WebAddress As String
WebAddress = "http://www.cnyes.com/twstock/ps_historyprice/" & 股號 & ".htm"
With ThisWorkbook.Worksheets(股號)
.Cells.Clear
Set QT = .QueryTables.Add("URL;" & WebAddress, .Range("$A$1"))
End With
With QT
.PostText = "ctl00$ContentPlaceHolder1$startText=" & 查詢起始日
.WebTables = "2"
.Refresh False
End With
Next
END SUB
