Macro for website copy and paste into excel...

[MTHassan]

Is it possible to copy from the website and paste into excel table by using macro code?
just like what I am doing manually copy from website and paste into excel .... plz advise if its possible...
web query is not working for this website... but manually copy and paste is working...
So, I need a macro code which can do the job...

http://www.biasl.net/pages/CompanyFundamental.aspx

Thanks

 

[Norie]

Right, I thought of something else.

As well as waiting for IE and the document, what about waiting for the objects we wan't to reference on the page.

In this code I've added a couple of loops, one for the tables collection and one for the actual table.

Seems to work, but obviously I've not tested it on other platforms, versions, planets etc.

Option Explicit
Sub MrExcel13Nov2010()
Dim wsNew As Worksheet
Dim rng As Range
Dim IE As Object
Dim doc As Object
Dim tbls As Object
Dim divContent As Object
Dim tbData As Object
Dim rw As Object
Dim col As Object
Dim cl As Object
Dim strBaseURL As String
 
    strBaseURL = "http://www.biasl.net/pages/CompanyFundamental.aspx"
 
    Set IE = CreateObject("InternetExplorer.Application")
 
    IE.Visible = True ' optional
 
    IE.navigate strBaseURL
 
    Do While IE.busy: DoEvents: Loop
 
    Do While IE.readystate <> 4: DoEvents: Loop
 
    Do While IE.document.readystate <> "complete": DoEvents: Loop
 
    Set doc = IE.document
 
    Do While IE.document.readystate <> "complete": DoEvents: Loop
 
    Set divContent = doc.getElementById("myGrid1_bodyDiv")
 
    Set tbls = divContent.getelementsbyTagName("TABLE")
 
    While tbls Is Nothing
        Set tbls = divContent.getelementsbyTagName("TABLE")
        DoEvents
    Wend
 
    Set tbData = tbls(0)
 
    While tbData Is Nothing
        Set tbData = tbls(0)
        DoEvents
    Wend
 
    Set wsNew = Worksheets.Add
 
    Set rng = wsNew.Range("A1")
 
    ' transfer data from table to the new worksheet
    For Each rw In tbData.Rows
        For Each cl In rw.Cells
            rng.Value = cl.innertext
            Set rng = rng.Offset(, 1)
        Next cl
        Set rng = wsNew.Cells(rng.Row + 1, 1)
    Next rw
 
    IE.Quit
 
End Sub

PS There might be a lot of looping and some of it might not be needed, feel free to remove any you don't want or think isn't needed.