Open Hypelinks from column and Copy all text on the next column

[GeoKoro13]

Hi there,

First of all, I have no experience in coding so whatever I have done is by searching online and asking. I have a file with multipe hypelinks. Each hypelink opens a database page on which I would like to check whether or not some keywords are present and report that back to excel. See below.

So, for instance when I open K2 link I want to check whether the keywords on the headings M1:T1 are present or not.
So, the way I was thinking to do (although it doesn't sound elegant) is to copy all the text from each page (since I'm not sure how to copy specific text) and paste it into to L2:L (Description) and then the formulae below the keywords will search.

So far I managed to find a code (see below) that open all the hyperlinks into Chrome.

Sub Test()
    Dim Sh As Worksheet
    Dim Rng As Range
    Dim Cell As Range
    Set Sh = Worksheets("Sheet1")
    With Sh
        Set Rng = .Range("K2:K" & .Cells(.Rows.Count, "K").End(xlUp).Row)
    End With
    For Each Cell In Rng
        ThisWorkbook.FollowHyperlink Cell.Value
    Next Cell
End Sub

It works fine but I'm getting the following error:

I have activated the references the Microsoft HTML Library and Internet Controls references.
Despite that issue, what I was thinking is to somehow between the operation of opening each hyperlink to copy all the texts from each page to the next column.

Do you have any idea/suggestion?

Thanks in advance,
George.

 

[GeoKoro13]

So, I've done the following so far.

Sub Test1()

Dim x As Integer

For x = 2 To 3


Shell "explorer.exe " & Cells(x, 12).Text
Application.Wait (Now + TimeValue("0:00:04"))

            Application.SendKeys ("^u")
Application.Wait (Now + TimeValue("0:00:01"))
            Application.SendKeys ("^a")
Application.Wait (Now + TimeValue("0:00:01"))
            Application.SendKeys ("^c")
Application.Wait (Now + TimeValue("0:00:01"))
            Application.SendKeys ("%{TAB}")
Application.Wait (Now + TimeValue("0:00:01"))
           Cells(x, 13).Select
Application.Wait (Now + TimeValue("0:00:05"))
            Application.SendKeys ("{F2}")
Application.Wait (Now + TimeValue("0:00:05"))
            Application.SendKeys ("^v")
Application.Wait (Now + TimeValue("0:00:05"))
            Application.SendKeys ("^{ENTER}")
Application.Wait (Now + TimeValue("0:00:05"))

Next x


End Sub

Since I'm getting no responses, I tried with a very messy way by using the SendKeys. All working ok when I use on Cell but when I try to loop, for some reason it only pastes the HTML to the very last cell of the loop (no matter if I increase the waiting time).

Can you please explain me why or help with any suggestion?

George.