Soru internet sayfasından tek seferlik tabloyu excel e aktarma

[sukrusoylu1986]

https://euipo.europa.eu/ec2/search/find?language=tr&text=&niceClass=&size=2500000&page=1&officeList=TR&searchMode=WORDSPREFIX&sortBy=relevance

linkinde yer alan yaklaşık 19bin satır sonucu tabloya çekmek istiyorum
IMPORTHTML ile denediğimde verilerin boyutunun büyüklüğü nedeni ile hata alıyorum.

Bu konu hakkında nasıl ilerleyebilirim.

 

[sukrusoylu1986]

bilgliendirme : ayrıca IMPORTCSV vs de denenmiş çgoogle üzerinden de sorgu yapılmıştır. Ancak sonuç alamadım.

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodu deneyiniz.

Sub Kod()
Dim x As Object, h As Object
Dim a As Long

Set x = CreateObject("MSXML2.XMLHTTP")
Set h = CreateObject("HTMLFile")
With x
    .Open "GET", "https://euipo.europa.eu/ec2/search/find?language=tr&text=&niceClass=&size=2500000&page=1&officeList=TR&searchMode=WORDSPREFIX&sortBy=relevance", False
    .Send
End With
DoEvents
h.Body.InnerHtml = x.ResponseText
x.abort
ReDim dz(1 To h.getelementbyid("advancedsearch_table").Rows.Length, 1 To 2)
DoEvents
For a = 1 To h.getelementbyid("advancedsearch_table").Rows.Length
    dz(a, 1) = h.getelementbyid("advancedsearch_table").Rows(a - 1).Cells(1).innertext
    dz(a, 2) = h.getelementbyid("advancedsearch_table").Rows(a - 1).Cells(2).innertext
Next
Range("A:B").ClearContents
Range("A1").Resize(UBound(dz), UBound(dz, 2)).Value = dz
End Sub