如何撈兩筆以上股票資料

各位高手好
小妹 vba小嫩嫩,這段程式有什麻方式可修改讓他不會卡住,求幫忙!!!感謝

Sub stock()
Dim oXMLHTTP As Object
Dim sPageHTML As String
Dim sURL As String '前面三項變數必key
a = 0
Do
a = a + 1
Select Case a
Case 1
sURL = "https://tw.stock.yahoo.com/q/q?s=" & Sheets(3).Cells(36, 6) '連結股票代號
Case 2
sURL = "https://tw.stock.yahoo.com/q/q?s=" & Sheets(3).Cells(37, 6)
End Select
Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
oXMLHTTP.Open "GET", sURL, False
oXMLHTTP.send
sPageHTML = oXMLHTTP.responseText
Select Case a
Case 1
Sheets(5).Cells(1, 1) = sPageHTML '將網頁資訊貼到這個位置
Case 2
Sheets(5).Cells(1, 2) = sPageHTML
End Select
If a = 2 Then
Exit Do
End If
Loop
aaa = Sheets(5).Cells(1, 1) '網址路徑aaa
aaalen = Len(aaa) 'len取網頁資訊
yy = 0
Y = 1
For t = 1 To aaalen '到網頁找特徵資料來擷取我們要的資料
If Mid(aaa, t, Len("nowrap")) = "nowrap" Then '特徵nowrap 要去文字檔搜尋網頁特徵
cc = 0
t = t + Len("nowrap")
q1 = ""
Do
If Mid(aaa, t, 1) = ">" Then 'aaa網路路徑資料,第t個值取第一筆資料
q1 = ""
cc = 1
yy = yy + 1
Y = Y + 1
If yy = 2 Then 'yy為第幾筆資料
t = t + 4 '從特徵資料到你要擷取的資料要加多少
ElseIf yy = 5 Then
t = t + 21
Else
t = t + 1
End If
End If
If Mid(aaa, t, 1) = "<" Then
If yy = 5 Then
Sheets(4).Cells(2, Y) = Left(RTrim(LTrim(q1)), Len(RTrim(LTrim(q1))) - 1) '將該欄資料置中
Else
Sheets(4).Cells(2, Y) = RTrim(LTrim(q1))
End If
q1 = ""
cc = 0
Exit Do
End If
If cc = 1 Then
q1 = q1 & Mid(aaa, t, 1)
End If
t = t + 1
Loop
End If
bbb = Sheets(5).Cells(1, 2) '網址路徑aaa
bbblen = Len(bbb) 'len取網頁資訊
yy = 0
Y = 1
For i = 1 To bbblen '到網頁找特徵資料來擷取我們要的資料
If Mid(bbb, i, Len("nowrap")) = "nowrap" Then '特徵nowrap 要去文字檔搜尋網頁特徵
cc = 0
i = i + Len("nowrap")
q1 = ""
Do
If Mid(bbb, i, 1) = ">" Then 'aaa網路路徑資料,第t個值取第一筆資料
q1 = ""
cc = 1
yy = yy + 1
Y = Y + 1
If yy = 2 Then 'yy為第幾筆資料
i = i + 4 '從特徵資料到你要擷取的資料要加多少
ElseIf yy = 5 Then
i = i + 21
Else
i = i + 1
End If
End If
If Mid(bbb, i, 1) = "<" Then
If yy = 5 Then
Sheets(4).Cells(3, Y) = Left(RTrim(LTrim(q1)), Len(RTrim(LTrim(q1))) - 1) '將該欄資料置中
Else
Sheets(4).Cells(3, Y) = RTrim(LTrim(q1))
End If
q1 = ""
cc = 0
Exit Do
End If
If cc = 1 Then
q1 = q1 & Mid(bbb, i, 1)
End If
i = i + 1
Loop
End If
Next i
Next t
End Sub