Request

Sub Request()

    Dim reqPart As Object
    Set reqPart = CreateObject("WinHttp.WinHttpRequest.5.1")
    reqPart.Open "GET", _
        "http://www.bmfbovespa.com.br/indices/ResumoCarteiraTeorica.aspx?Indice=IBOVESPA&idioma=pt-br"

    reqPart.Send

    Dim reqPl As Object
    Set reqPl = CreateObject("WinHttp.WinHttpRequest.5.1")
    reqPl.Open "GET", _
        "http://www.fundamentus.com.br/resultado.php"

    reqPl.Send


    Dim i As Integer
    Dim pos1 As Long
    Dim pos2 As Long
    Dim strPart As String
    Dim strPl As String
    Dim temp As String
    Dim r1 As String
    Dim r2 As String

    strPart = reqPart.ResponseText
    strPl = reqPl.ResponseText

    Range("A2:C1000").Clear

    i = 2
    Do While 1
        pos1 = InStr(strPart, "lblCodigo")

        If (pos1 = 0) Then
            Exit Do
        End If

        strPart = Mid(strPart, pos1 + 9)

        pos1 = InStr(strPart, ">")
        pos2 = InStr(strPart, "<")

        r1 = Mid(strPart, pos1 + 1, pos2 - pos1 - 1)

        Cells(i, 1).Value2 = r1

        pos1 = InStr(strPart, "lblPart_Formatada")
        strPart = Mid(strPart, pos1 + 17)

        pos1 = InStr(strPart, ">")
        pos2 = InStr(strPart, "<")

        r2 = Mid(strPart, pos1 + 1, pos2 - pos1 - 1)
        r2 = Replace(r2, ",", ".")

        Cells(i, 2).Value2 = Val(r2)

        pos1 = InStr(strPl, "detalhes.php?papel=" & r1)
        temp = Mid(strPl, pos1)
        pos1 = InStr(temp, "<td>")
        temp = Mid(temp, pos1 + 1)
        pos1 = InStr(temp, "<td>")
        temp = Mid(temp, pos1 + 4)
        pos2 = InStr(temp, "<")

        r1 = Mid(temp, 1, pos2 - 1)
        r1 = Replace(r1, ".", "")
        r1 = Replace(r1, ",", ".")

        Cells(i, 3).Value2 = Val(r1)

        i = i + 1
    Loop

End Sub